Demo entry 6881451

Excel Consultor

   

Submitted by W on Sep 11, 2019 at 03:22
Language: VBScript. Code size: 1.6 kB.

Sub crearIndice()



'**************************************

'PASO 1: Crear o limpiar la hoja Indice

'**************************************

Dim hoja As Worksheet

On Error Resume Next

Set hoja = Worksheets("Indice")

On Error GoTo 0



If hoja Is Nothing Then

    'La hoja Indice no existe - Crearla en primera posición

    Worksheets.Add(Before:=Worksheets(1)).Name = "Indice"

Else

    'La hoja Indice ya existe - Limpiarla

    Worksheets("Indice").Cells.Clear

End If



'Insertar título a la hoja Indice

Worksheets("Indice").Range("A1").Value = "Indice"





'************************************************

'PASO 2: Recorrer las hojas creando hipervinculos

'************************************************

Dim fila As Long

Dim vinculoRegreso As String



fila = 2

'Celda donde se colocará el hipervinculo de regreso al indice

vinculoRegreso = "C1"



For Each hoja In Worksheets

    If hoja.Name <> "Indice" Then

        'Crear hipervinculo en hoja Indice

        With Worksheets("Indice")

            .Hyperlinks.Add Anchor:=.Cells(fila, 1), _

            Address:="", _

            SubAddress:="'" & hoja.Name & "'!A1", _

            TextToDisplay:=hoja.Name

        End With

       

        'Crear hipervinculo en hoja destino hacia Indice

        With hoja

            .Hyperlinks.Add Anchor:=.Range(vinculoRegreso), _

            Address:="", _

            SubAddress:="Indice!A1", _

            TextToDisplay:="Indice"

        End With

        fila = fila + 1

    End If

Next



End Sub

This snippet took 0.00 seconds to highlight.

Back to the Entry List or Home.

Delete this entry (admin only).