Cómo aplicar. ClearOutline On QueryTable?

Estoy poniendo esbozos en una tabla que obtiene datos de Power Query a través de VBA basados en datos en la propia tabla.

ActiveSheet.Rows(2).Cells(7).Activate ' Set the row containing the OutlineLevel value to be active
Dim RowNumber As Integer ' Counter for the row we're on
For RowNumber = 2 To ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row ' Go from the first data row to the last row containing data in the first cell of the sheet
    ActiveCell.EntireRow.OutlineLevel = CInt(ActiveCell.Value) ' Set the outline level
    ActiveCell.Offset(1, 0).Activate ' Go to the next row in the sheet
Next RowNumber

Eso funciona siempre y cuando aclare el esquema manualmente primero. Sin embargo, cuando aclaro todos los esbozos primero ejecutando:

ActiveSheet.Rows().ClearOutline

I get

Error de ejecución '1004': ClearOutline método de clase Range falló

Traté de limpiar el contorno para todas las filas corriendo:

ActiveSheet.Rows().OutlineLevel = 1

Eso causa un retraso de 30-150ms cuando me puse .OutlineLevel, y para 150K filas, eso va a causar problemas.

Pregunta hecha hace 3 años, 5 meses, 0 días - Por codemasterx

3 Respuestas:

  • ActiveSheet.Rows(). ClearOutline

    Con .Rows(). estás recibiendo ese error porque no sólo estás tratando de desagrupar las filas que tienen el agrupamiento, sino también el resto de las filas en la hoja de trabajo que no están agrupadas y por lo tanto estás recibiendo el error.

    Encase esa línea con OERN e inténtelo de nuevo

    On Error Resume Next
ActiveSheet.Rows().ClearOutline
On Error GoTo 0

    O asegúrese de encontrar las filas pertinentes que se agrupan y luego no se agrupan sólo esas filas. Algo así.Untested)

    Dim rng As Range
Dim i As Long
Dim ws As Worksheet
Dim lRow As Long

Set ws = Sheet1

With ws
    lRow = .Range("A" & .Rows.Count).End(xlUp).Row
    
    For i = 1 To lRow
        If .Rows(i).OutlineLevel > 1 Then
            If rng Is Nothing Then
                Set rng = Rows(i)
            Else
                Set rng = Union(rng, Rows(i))
            End If
        End If
    Next i
End With

If Not rng Is Nothing Then rng.ClearOutline

    Respondida el Dec 17, 2020 a las 04:00 - por codexcrafter

    Votos positivos: 0 | Votos negativos: 0

  • Para aplicar ClearOutline en un QueryTable, debes manipular directamente el QueryTable en lugar de intentar limpiar los esbozos a través de las filas de la hoja de cálculo. Aquí hay un ejemplo de cómo puedes aplicar ClearOutline en una QueryTable:

    vb
' Referenciar al QueryTable en la hoja activa
Dim qt As QueryTable
Set qt = ActiveSheet.QueryTables(1)  ' Ajusta el índice (1 en este caso) según sea necesario

' Limpiar los esbozos del QueryTable
qt.RefreshStyle = xlInsertDeleteCells
qt.Refresh

' Luego puedes volver a crear los esbozos de la manera que lo estabas haciendo antes

    Con este enfoque, deberías poder aplicar ClearOutline al QueryTable en lugar de a las filas directamente, lo que debería evitar el error que estás experimentando. Asegúrate de ajustar el índice en ActiveSheet.QueryTables(1) para que coincida con la QueryTable que estás utilizando en tu hoja.

    Respondida el Dec 18, 2020 a las 03:58 - por Gpt

    Votos positivos: 0 | Votos negativos: 0

  • El error que estás recibiendo se debe a que el método ClearOutline solo se puede aplicar a rangos individuales, no a toda la hoja de trabajo. Para borrar los esquemas de toda la hoja de trabajo, debes recorrer cada fila y borrar el esquema de cada rango individual.

    Aquí tienes un código modificado que debería resolver el problema:

    vb
Sub ClearAllOutlines()
    Dim RowNumber As Integer

    ' Recorrer cada fila en la hoja de trabajo
    For RowNumber = 2 To ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
        ' Borrar el esquema de la fila actual
        ActiveSheet.Rows(RowNumber).ClearOutline
    Next RowNumber
End Sub

    Este código recorrerá cada fila de la hoja de trabajo y borrará el esquema de cada fila individualmente, lo que debería resolver el error que estás encontrando.

    Respondida el Dec 18, 2020 a las 04:07 - por Gemini

    Votos positivos: 0 | Votos negativos: 0