PROBLEMA CON SENTENCIA CELLS().COLUMNS().UNGROUP

[jesuspg]

Hola compañeros,

Llevo un tiempo con un problema en el siguiente código, y no sé cómo solucionarlo.

Private Sub Worksheet_Activate()
   Cells().Columns().Ungroup             ' 1
   Columns(4).Group                      ' 2
   Columns(5).Group                      ' 3
   Me.Outline.ShowLevels ColumnLevels:=1 ' 4
End Sub

Me gustaría insertar un condicional en la primera sentencia tal que "If Cells().Columns().Group = True Then Cells.Columns.Ungroup", para de este modo ejecutar el resto de las sentencias (la segunda, tercera y cuarta) sin problemas. Pero esa instrucción me da problemas...

En otras palabras, un evento tal que al activar la hoja, se agrupen la cuarta y quinta columna.

Adjunto fichero para que vean mejor el problema.

PRUEBA.xlsm

Muchísimas gracias de antemano por vuestro tiempo.

[AlexanderS]

Hola @paikerr intenta así:

Dim rango As Range

Set rango = Range(Columns(1), Columns(6))

If IsNull(rango.OutlineLevel) Then rango.Ungroup

Comentas, saludos. 

[Antoni]

"Muerto el perro, se acabó la rabia". (Dicho popular)

Private Sub Worksheet_Activate()
On Error Resume Next
   Columns.Ungroup                       ' 1
   Columns(4).Group                      ' 2
   Columns(5).Group                      ' 3
   Me.Outline.ShowLevels ColumnLevels:=1 ' 4
End Sub

 

[jesuspg]

En 17/10/2020 at 9:56 , Antoni dijo:

"Muerto el perro, se acabó la rabia". (Dicho popular)

Private Sub Worksheet_Activate()
On Error Resume Next
   Columns.Ungroup                       ' 1
   Columns(4).Group                      ' 2
   Columns(5).Group                      ' 3
   Me.Outline.ShowLevels ColumnLevels:=1 ' 4
End Sub

 

Hola @Antoni, no puedo introducir otro tratamiento de errores porque mi código es tan sólo el extracto de otro código mucho más completo, y ya tengo definido otro tratamiento de errores.

En otras palabras, quedaría algo como esto...

Private Sub Worksheet_Activate()

   ' Tratamos los errores de la aplicación ofimática...
   On Error GoTo error

   ' Desagrupamos todas las columnas...
   Columns.Ungroup                       ' 1
   Columns(4).Group                      ' 2
   Columns(5).Group                      ' 3
   Me.Outline.ShowLevels ColumnLevels:=1 ' 4

salir:
   ' Y salimos del procedimiento...
   Exit Sub

error:
   ' Mostramos por pantalla el tipo de error y la descripción del mismo...
   MsgBox Prompt:="Upps, parece que hubo un error... Por favor, póngase directamente " & _
                  "en contacto con su programador informático." & vbCr & vbCr & _
                  "El error producido es: [" & Err.Number & "] - " & Err.Description, _
          Buttons:=vbCritical, _
          Title:="                                               AVISO IMPORTANTE"

   ' Sacamos el error fuera de la pila de errores...
   Resume salir

End Sub

O mucho me equivoco pero si pusiera "On Error Resume Next", nunca sabría dónde me está dando un error.

Por eso buscaba solucionar el problema con un If (sentencia condicional).

Gracias de todos modos por tu respuesta.

[jesuspg]

En 17/10/2020 at 3:16 , AlexanderS dijo:

Hola @paikerr intenta así:

Dim rango As Range

Set rango = Range(Columns(1), Columns(6))

If IsNull(rango.OutlineLevel) Then rango.Ungroup

Comentas, saludos. 

Funciona muy bien, pero me gustaría definir la variable rango con el código que me has pasado de esta manera:

   Dim rango As Range
   Set rango = Range("A1").CurrentRegion

Pero me da error. Concretamente, dice:

Se ha producido el error '1004' en tiempo de ejecución: No se puede obtener la propiedad OutlineLevel de la clase Range.

Otro problema es que me gustaría dejar todo desagrupado hasta el nivel 0. Es decir, en caso de que existieran varios niveles de agrupación, el programa los va eliminando uno a uno. Pero me gustaría que eliminara todos los niveles de golpe. Es esto posible?

 

Gracias por tomarte un tiempo en ayudarme con mis dudas.

[Antoni]

Private Sub Worksheet_Activate()
On Error Resume Next
   Columns.Ungroup                       ' 1
   Columns(4).Group                      ' 2
   Columns(5).Group                      ' 3
   Me.Outline.ShowLevels ColumnLevels:=1 ' 4
On Error GoTo error
End Sub

"A grandes males, grandes remedios", otro dicho popular. ?