martes, 27 de marzo de 2018

VBA: Crear un índice de hojas con autoformas

Veremos en el post de hoy como generar en Excel un índice de todas las hojas que existan en nuestro libro de trabajo, pero en este caso asociándolo a unas Autoformas...
Tal como se ve en la imagen siguiente:

VBA: Crear un índice de hojas con autoformas



Esta personalización no permitirá crear rápidamente un índice de hojas empleando nuestras autoformas favoritas, con las características de formato de forma que deseemos...
Importante!, el índice se genera en una hoja que he llamado 'Menu'.


En un módulo estándar del libro incluimos el siguiente procedimiento:

Sub CreaIndice_con_AutoForma()
Dim wks As Worksheet

alt = 0
For Each sh In Sheets
    If sh.Name <> "Menu" Then
        Set wks = Worksheets("Menu")
        Dim miForma As Shape
        'definimos la forma de Rectángulo redondeado
        ' .AddShape ( Tipo , izquierda , arriba , ancho , alto )
        Set miForma = wks.Shapes.AddShape(msoShapeRoundedRectangle, 5, 10 + alt, 75, 50)
        alt = alt + 60
        'añadimos como texto el nombre de la hoja destino/ en negrita
        With miForma.TextFrame.Characters
            .Text = "Ir a " & sh.Name
            .Font.Bold = True
        End With
        'alineamos texto centrado vertical/horizontal
         With miForma
            .TextFrame2.VerticalAnchor = msoAnchorMiddle
            .TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
        End With
        'carácterísticas 3D de la forma con Bisel circular
        miForma.ThreeD.BevelTopType = msoBevelCircle
        'y del color de fondo
        miForma.Fill.ForeColor.RGB = RGB(197, 90, 17)
        'y también efecto de luminosidad
        With miForma.Glow
            .Color.RGB = RGB(197, 90, 17)
            .Transparency = 0.6
            .Radius = 8
        End With
        
        ' y finalmente añadimos la funcionalidad de hipervínculo a la Autoforma
        wks.Hyperlinks.Add Anchor:=miForma, _
                address:="", _
                SubAddress:=sh.Name & "!" & Cells(1, 1).address
    End If
Next sh

End Sub



El resultado se visualiza rápidamente.

Se observa como el orden de las hojas es el mismo en el que aparecen dispuestas en el libro...

3 comentarios:

  1. Respuestas
    1. Hola qué tal estás?
      un placer saludarte igualmente
      ASegúrate que la fila 37:
      address:="", _
      te aparece el guión bajo después de un espacio en blanco
      Saludos

      Eliminar