Hoja auxiliar de control de visibilidad de hojas

verzulsan · el 20 de diciembre

Hello

Permite cómodamente trabajar con muchas hojas ayudándote a organizar las hojas por categorías o decidir cuáles estarán visibles u ocultas.

Pues pegado este código (made in sevilla) en cualquier hoja (dejo adjunto aun que da el mismo resultado pegar el codigo en una hoja cualquiera), la convierte en un panel de control de visibilidad de todas las hojas que contenga el libro. Muy fácil de usar, únicamente hay que copiar la hoja en cualquier libro.

Option Explicit


Private Const PreFix As String = " (ws) "  'Prefijo añadido al nombre de hoja para dinamizar el trato de hojas, _

        me explico: _

        Para poder generar un listado dinamico donde la lista no sea necesariamente en una columna de arriba a _

        abajo, necesito reconocer el nombre en la celda inequivocamente, ya que si hay una celda llamada _

        "FACTURAS" que indica "el nombre" de la hoja con todas las facturas y otra celda que pone _

        "FACTURAS PASADAS" que significa el rotulo, o un apunte mio o lo que sea, pues la hemos pifiado _

        ya el programa lo tomará como una hoja real, pero si le añadimos un prefijo, " (ws) ", o cualquier _

        otro prefijo, es muy improbable que manualmente se introduzca el prefijo, _

        AUN QUE NO IMPOSIBLE, pero queda ya fuera de mi analisis por improbable. _

_

        RECUERDA: Las funciones estan preparadas para que prefijo tenga un espacio al principio y al final, _

        Si se quiere quitar los espacios, habria que retocar todas las funciones que dependen de este formato. _

        Ejem1: " (Nueva Etiqueta) "  -> Correcto _

        Ejem2: " -=]Nueva Etiqueta[=- "  -> Correcto _

        Ejem3: "(Nueva Etiqueta)"  -> Incorrecto





Private Sub Worksheet_Activate()

    Dim ws As Worksheet

    Dim i As Long

    '

    Dim p As Range  'Var Aux para recorrer los rangos


    Dim RangoPreFix As Range    'Rango que engloba todas las celdas con PreFix (Existan o no las hojas)


    Dim ColorRojo As Long  'Color de las hojas que no se han encontrado en la coleccion de hojas del libro

    Dim ColorVerde As Long  'Color de las hojas que se han encontrado y que estan visibles

    Dim ColorAzul As Long  'Color de las hojas que se han encontrado y que estan ocultas


    ColorRojo = RGB(255, 0, 0)

    ColorVerde = RGB(0, 128, 0)

    ColorAzul = RGB(0, 0, 255)


    Dim HojasIntocables As String  'Array concatenado en texto con los nombres de hojas especiales _

    que no van a ser tratadas automaticamente por las macros de ocultacion y mostracion



    'Agrega tantas lineas como hojas necesites proteger

    HojasIntocables = HojasIntocables & "#" & "Cpanel" & "#"

    HojasIntocables = HojasIntocables & "#" & "HojaProtegida" & "#"

    i = 1


    'Coloreamos de color rojo todas las casillas con prefijo, _

    De esta manera, inicialmente no existe ninguna hoja asociada a ninguna celda. _

    Asi que cuando termine el recuento de hojas, las que queden de rojo, son las que _

    realmente no existen.

    Call setFormatoCasillaHoja(BuscarPreFix, ColorRojo)


    'Recorre todas las hojas del libro en WS y (busca o crea) una celda linkada al estado de visibilidad de la hoja

    For Each ws In ThisWorkbook.Sheets

        If InStr(1, HojasIntocables, "#" & ws.Name & "#", vbTextCompare) = 0 Then

            'La hoja no está protegida

            Set p = FindCellRangeByValue(PreFix & ws.Name)


            If p Is Nothing Then

            'Si no encuentra la celda p, la crea en un hueco libre


                'Apunta a la primera fila disponible de la columna 1

                Do While (Cells(i, 1) <> "")

                    i = i + 1

                Loop

                Set p = Cells(i, 1)

                p.Value = PreFix & ws.Name

            End If


            'Marca la celda como Hoja (visible/oculta)

            If ws.Visible = True Then

                Call setFormatoCasillaHoja(p, ColorAzul)

            Else

                Call setFormatoCasillaHoja(p, ColorVerde)

            End If


        End If

    Next

End Sub




'Da formato a los caracteres desde la posicion 2 hasta largo(PreFix)-2

Private Sub setFormatoCasillaHoja(ByRef Celda As Range, ByRef Tono As Long)

  Dim Largo As Long

  On Error GoTo ErrorsetFormatoCasillaHoja

  Largo = Len(PreFix) - 2

  With Celda.Characters(Start:=2, Length:=Largo).Font

  .Superscript = True

  .Color = Tono

  End With

ErrorsetFormatoCasillaHoja:

End Sub



'Busca una coincidencia exacta de texto en toda la hoja

Private Function FindCellRangeByValue(Nombre As String) As Range

    On Error GoTo ErrorFindCellRangeByValue


    Dim Celda As Range

    Set Celda = Cells.Find(Nombre, [A1], -4123, 1, 1, 1, 1, 0, False)


ErrorFindCellRangeByValue:

    Set FindCellRangeByValue = Celda

End Function



'Genera y devuelve un rango con la seleccion de todas las casillas que contentan el PreFix en la primera posicion.

Private Function BuscarPreFix() As Range

    On Error GoTo FinDeFuncion

    Dim Rango As Range

    Dim p As Range, q As Range



    Set p = Cells.Find(PreFix, [A1], -4123, 2, 1, 1, 0, 0, True)

    Set q = p

    Do

        If InStr(1, p.Value, PreFix, vbTextCompare) = 1 Then

            If Rango Is Nothing Then

                Set Rango = p

            Else

                Set Rango = Union(Rango, p)

            End If

        End If


        Set p = Cells.Find(PreFix, p, -4123, 2, 1, 1, 0, 0, True)

        If q.Address = p.Address Then Exit Do

    Loop


FinDeFuncion:

    Set BuscarPreFix = Rango

End Function



'Evento de doble click que actua como switch en las celdas etiquetadas con PreFix (muestra u oculta hojas)

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    Dim ws As Worksheet


    If Target.Count = 1 Then

    'Si el evento afecta a una sola celda

        If InStr(1, Target.Value, PreFix, vbTextCompare) = 1 Then

        'Si el prefijo está al inicio del string

            'Se comprueba que la hoja existe (Se le pasa la cadena sin el prefijo)

            Set ws = ExisteHoja(Mid(Target.Value, Len(PreFix) + 1, Len(Target.Value) - Len(PreFix)))

            'Comprueba que la hoja exista antes de invertir visibilidad

            If Not (ws Is Nothing) Then

                Cancel = True

                Application.ScreenUpdating = False

                If ws.Visible = True Then

                    ws.Visible = False

                    Call setFormatoCasillaHoja(Target, RGB(0, 128, 0))

                Else

                    ws.Visible = True

                    Call setFormatoCasillaHoja(Target, RGB(0, 0, 255))

                End If

                Application.ScreenUpdating = True

            End If

        End If

    End If

End Sub



'Comprueba si una hoja existe

'Parametro

'Asociado al nombre, Devuelve la hoja, si la hoja existe, hoja vacia si la hoja no existe

Private Function ExisteHoja(NombreHoja As String) As Worksheet

    Dim hojaAux As Worksheet

    On Error GoTo Errores


    Set hojaAux = Sheets(NombreHoja)


Errores:

    Set ExisteHoja = hojaAux


End Function


[/CODE]

Consta de 2 eventos automáticos:

[size=5][u][b]Evento 1:[/b][/u][/size] Activación de Hoja

[indent]Al activar la hoja (esto es simplemente entrar en la hoja), se genera un listado (en la columna A desde la celda A1) en donde cada celda del listado contiene el nombre una de las hojas del libro que haya superado el filtro interno de hojas a tratar, llamaré "Celdas Hoja" a dichas celdas. La peculiaridad que tiene es que una vez generado ese listado, puedes mover las "Celdas Hoja" a otras posiciones y cuando vuelvas a entrar en la hoja, el listado se respeta.[/indent]

Si existen datos en la columna A, buscará el primer hueco vacio.

[u][b]Una "Celda Hoja"[/b][/u],

[indent]consta de un "Prefijo" que la identifica, en este caso el prefijo es (ws) que viene de "WorkSheet" (podeis cambiar esta constante por cualquier otro prefijo), si una celda contiene un prefijo en cualquier parte que no sea en la posición 1, entonces no es una "Celda Hoja".[/indent]

[b][u]El prefijo[/u][/b] de las "Celdas Hoja" puede ser de [b][u]3 colores[/u][/b]:

[indent][b][u][color=#0000ff]Azul:[/color][/u][/b] La hoja referida por la "Celda Hoja" está visible

[color=#336600][u][b]Verde:[/b][/u][/color] La hora referida por la "Celda Hoja" está oculta, he escogido verde porque mentalmente me recuerda a los comentarios en verde del VBA, como diciendo, Hoja desactivada, hoja oculta, podéis toquetear el código y poner el color que mas coraje os dé.

[color=#ff0000][u][b]Rojo:[/b][/u][/color] Son "Ex-Celdas Hoja", es decir, fueron "Celdas Hoja" pero por el motivo que sea, esa hoja ya no existe con ese nombre en todo el libro. Generalmente va a ocurrir cuando cambiamos el nombre de una hoja y volvemos a la de Panel. También puede ocurrir si tenemos 2 o más "Celdas Hoja" idénticas, en este caso, la macro tomará la primera que encuentre como valida dejando en rojo la segunda (Está hecho así adrede).[/indent]

[u][b]Evento 2:[/b][/u] Doble Click

[indent]Haciendo doble click en una "Celda Hoja" (Cualquiera cuyo prefijo no sea rojo), invierte el estado de la hoja relacionada actuando como switch de la misma. Si la hoja está visible, se oculta, y si está oculta, se hará visible.[/indent]

[size=3][color=#ff0000]NOTA:[/color] Para que la macro ignore algunas hojas que consideramos que no deberían ser tratadas por la macro, agregadlas dentro del código, al igual que las dos hojas del ejemplo de abajo (“Cpanel” y “HojaProtegida”):[/size]

[CODE]HojasIntocables = HojasIntocables & "#" & "Cpanel" & "#"
HojasIntocables = HojasIntocables & "#" & "HojaProtegida" & "#"
HojasIntocables = HojasIntocables & "#" & "NombreHoja3" & "#"
HojasIntocables = HojasIntocables & "#" & "NombreHoja4" & "#"[/CODE]

[size=3]Agregad tantas líneas como hojas queráis proteger.[/size]

Merry Christmas

Hoja auxiliar de control de visibilidad de hojas_vzs.xls