Como modificar el diseño de una Tabla Dinámica con VBA

Resulta que mediante VBA estoy creando una tabla dinámica y estoy tratando de darle cierto formato o diseño, la tabla se crea correctamente pero el diseño no se quiere aplicar, este es el código que uso actualmente

Private Sub cmdrmn_Click()
    Dim PCache As PivotCache
    Dim TDinamica As PivotTable
    Dim WS As Worksheet
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set WS = Worksheets("EMPALMES2")
    On Error Resume Next
    'Crear PivotCache
    Set PCache = ActiveWorkbook.PivotCaches.Create(xlDatabase, "Datos_Hidrantes")
    'Crear Tabla Dinamica
    Set TDinamica = PCache.CreatePivotTable(WS.Range("L1"))
    'Insertar filas
    With TDinamica.PivotFields("Código")
        .Orientation = xlRowField
        .Position = 1
    End With
    With TDinamica.PivotFields("Elementos")
        .Orientation = xlRowField
        .Position = 2
    End With
    With TDinamica.PivotFields("Cantidad")
        .Orientation = xlRowField
        .Position = 3
    End With
    With TDinamica.PivotFields("Unidad")
        .Orientation = xlRowField
        .Position = 4
    End With
'Formato (Diseño)
With ActiveSheet.PivotTables("TablaDinámica4")
        .ColumnGrand = False
        .RowGrand = False
    End With
'    ActiveSheet.PivotTables("TablaDinámica4").PivotFields("Hidrantes").Subtotals = _
'        Array(False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("TablaDinámica4").PivotFields("Código").Subtotals = _
        Array(False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("TablaDinámica4").PivotFields("Elementos").Subtotals = _
        Array(False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("TablaDinámica4").PivotFields("Cantidad").Subtotals = _
        Array(False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("TablaDinámica4").PivotFields("Unidad").Subtotals = _
        Array(False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("TablaDinámica4").RowAxisLayout xlTabularRow
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Así se me crea la tabla:

Y así es como la necesito:

1 respuesta

Respuesta
1

Ya logre resolver el problema, simplemente olvide asignar el nombre a la tabla dinámica, les dejo el código corregido por si a alguien le puede servir

Private Sub cmdrmn_Click()
    Dim PCache As PivotCache
    Dim TDinamica As PivotTable
    Dim WS As Worksheet
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set WS = Worksheets("EMPALMES2")
    On Error Resume Next
    'Crear PivotCache
    Set PCache = ActiveWorkbook.PivotCaches.Create(xlDatabase, "Datos_Hidrantes")
    'Crear Tabla Dinamica
'    Set TDinamica = PCache.CreatePivotTable(WS.Range("L1"))
    Set TDinamica = PCache.CreatePivotTable( _
    TableDestination:="EMPALMES2!R1C12", TableName:="Empalmes")
    'Insertar filas
    With TDinamica.PivotFields("Código")
        .Orientation = xlRowField
        .Position = 1
    End With
    With TDinamica.PivotFields("Elementos")
        .Orientation = xlRowField
        .Position = 2
    End With
    With TDinamica.PivotFields("Cantidad")
        .Orientation = xlRowField
        .Position = 3
    End With
    With TDinamica.PivotFields("Unidad")
        .Orientation = xlRowField
        .Position = 4
    End With
'Formato (Diseño)
With ActiveSheet.PivotTables("Empalmes")
        .ColumnGrand = False
        .RowGrand = False
    End With
    ActiveSheet.PivotTables("Empalmes").PivotFields("Código").Subtotals = _
        Array(False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("Empalmes").PivotFields("Elementos").Subtotals = _
        Array(False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("Empalmes").PivotFields("Cantidad").Subtotals = _
        Array(False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("Empalmes").PivotFields("Unidad").Subtotals = _
        Array(False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("Empalmes").RowAxisLayout xlTabularRow
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas