VBA: Ocultando y Mostrando varias hojas al tiempo.

Sin duda una de las cuestiones más tediosas de Excel es el momento en que queremos Ocultar o Mostrar varias hojas a la vez.. entonces nos damos cuenta que el estándar de Excel únicamente nos permite realizar la acción hoja a hoja!!!...
Algo a mejorar por Microsoft ;-)

La propuesta de hoy es construir un UserForm (formluario de usuario) que gestione fácilmente esta acción múltiple de ocultar/mostrar.

Emplearé un código muy práctico (algo largo) ya expuesto en el blog (ver) que nos habilita la operación simplemente arrastrando los elementos...

Comenzaremos creando un Userform al que he llamado 'frmOcultarMostrar'.
Este formulario tiene los siguientes controles:
Dos ListBox: ListVisible y ListOcultas.
Dos etiquetas
Un Botón: CmdCerrar

El formulario tendría un diseño similar a este:

Insertamos el siguiente código dentro de la ventana de código del UserForm desde el editor de VB:

Dim matrizHojas() As Boolean
Private Sub UserForm_Initialize()
ReDim matrizHojas(Sheets.Count)
'limpiamos los ListBox del formulario
Me.ListVisible.Clear
Me.ListOcultas.Clear

'recorremos todas las hojas del libro
For i = 1 To Sheets.Count
    'llenamos nuestra Array con TRUE o FALSE
    matrizHojas(i) = Sheets(i).Visible
        
    If matrizHojas(i) = True Then
        'si es visible lo cargamos en el ListBox de 'hojas visibles'
        Me.ListVisible.AddItem Sheets(i).Name
    Else
        'si NO es visible lo cargamos en el ListBox de 'hojas ocultas'
        Me.ListOcultas.AddItem Sheets(i).Name
    End If
Next i
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub ListOcultas_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As _
    MSForms.DataObject, ByVal x As Single, _
    ByVal Y As Single, ByVal DragState As Long, _
    ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
    'este evento se produce cuando se está ejecutando una operación de arrastrar y colocar.
    Cancel = True
    Effect = 1
End Sub
Private Sub ListVisible_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As _
    MSForms.DataObject, ByVal x As Single, _
    ByVal Y As Single, ByVal DragState As Long, _
    ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
    'este evento se produce cuando se está ejecutando una operación de arrastrar y colocar.
    Cancel = True
    Effect = 1
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub ListOcultas_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, _
    ByVal Action As Long, ByVal Data As MSForms.DataObject, ByVal x As Single, _
    ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
    'este otro evento se produce cuando el usuario está a punto de colocar o pegar datos en un objeto.
    Cancel = True
    Effect = 1

    Dim iIndex As Long, col As Integer
    With ListVisible
        'determinamos cuál ha sido el elemento seleccionado
        iIndex = ListVisible.ListIndex
        'añadimos un elemento al ListBox de destino...
        ListOcultas.AddItem .List(iIndex, 0), 0
        'incorporamos los valores de las diferentes columnas
        'desde el ListBox de origen al ListBox destino
        For col = 1 To ListVisible.ColumnCount - 1
            ListOcultas.List(0, col) = .List(iIndex, col)
        Next col
    End With
End Sub
Private Sub ListVisible_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, _
    ByVal Action As Long, ByVal Data As MSForms.DataObject, ByVal x As Single, _
    ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
    'este otro evento se produce cuando el usuario está a punto de colocar o pegar datos en un objeto.
    Cancel = True
    Effect = 1

    Dim iIndex As Long, col As Integer
    With ListOcultas
        'determinamos cuál ha sido el elemento seleccionado
        iIndex = ListOcultas.ListIndex
        'añadimos un elemento al ListBox de destino...
        ListVisible.AddItem .List(iIndex, 0), 0
        'incorporamos los valores de las diferentes columnas
        'desde el ListBox de origen al ListBox destino
        For col = 1 To ListOcultas.ColumnCount - 1
            ListVisible.List(0, col) = .List(iIndex, col)
        Next col
    End With
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub ListVisible_MouseMove(ByVal Button As Integer, _
    ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
'este evento se produce cuando el usuario mueve el mouse...
Dim MyDataObject As DataObject
If Button = 1 Then
    Set MyDataObject = New DataObject
    Dim Effect As Integer
    'Con el método .SetText copiamos una cadena de texto al objeto DataObject...
    MyDataObject.SetText ListVisible.Value
    'el método .StartDrag da inicio a una operación de arrastrar y colocar para un objeto DataObject.
    Effect = MyDataObject.StartDrag
End If

For i = 0 To ListVisible.ListCount - 1
    If ListVisible.Selected(i) = True Then
    For j = 1 To Sheets.Count
        If Sheets(j).Name = ListVisible.List(i) Then
            matrizHojas(j) = False
            On Error GoTo finaliza
            Sheets(j).Visible = False
        End If
    Next j
    End If
Next i

'refrescamos situación....
ActualizaFormulario
Exit Sub

finaliza:
'controlamos que siempre quede al menos una hoja visible...
If ListVisible.ListCount = 1 Then
    MsgBox "No se pueden ocultar todas las hojas.." & vbCrLf & "Siempre debe quedar al menos una visible"
    ActualizaFormulario
    Exit Sub
End If

End Sub
Private Sub ListOcultas_MouseMove(ByVal Button As Integer, _
    ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
'este evento se produce cuando el usuario mueve el mouse...
Dim MyDataObject As DataObject
If Button = 1 Then
    Set MyDataObject = New DataObject
    Dim Effect As Integer
    'Con el método .SetText copiamos una cadena de texto al objeto DataObject...
    MyDataObject.SetText ListOcultas.Value
    'el método .StartDrag da inicio a una operación de arrastrar y colocar para un objeto DataObject.
    Effect = MyDataObject.StartDrag
End If


For i = 0 To ListOcultas.ListCount - 1
    If ListOcultas.Selected(i) = True Then
    For j = 1 To Sheets.Count
        If Sheets(j).Name = ListOcultas.List(i) Then
            matrizHojas(j) = True
            Sheets(j).Visible = True
        End If
    Next j
    End If
Next i

'refrescamos situación....
ActualizaFormulario
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ActualizaFormulario()
'limpiamos los ListBox del formulario
Me.ListVisible.Clear
Me.ListOcultas.Clear

'recorremos todas las hojas del libro
For i = 1 To Sheets.Count
    'llenamos nuestra Array con TRUE o FALSE
    matrizHojas(i) = Sheets(i).Visible

    If matrizHojas(i) Then
        'si es visible lo cargamos en el ListBox de 'hojas visibles'
        Me.ListVisible.AddItem Sheets(i).Name
    Else
        'si NO es visible lo cargamos en el ListBox de 'hojas ocultas'
        Me.ListOcultas.AddItem Sheets(i).Name
    End If
Next i
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub CmdCerrar_Click()
    Unload Me
End Sub

Basta ejecutar o lanzar el formulario y arrastrar hojas de un ListBox a otro...

El código tiene un control de error para evitar que todas las hojas queden ocultas... lo que es imposible para Excel.

Es un código un poco largo, pero la funcionalidad y los eventos:
_MouseMove
_BeforeDropOrPaste
y
_BeforeDragOver
se deben repetir para ambos ListBox, ya que el arrastrar de una posición a otra debe estar configurada...