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 SubAsí se me crea la tabla:

Y así es como la necesito:

1 respuesta
Respuesta de Juan Diego Arango Ochoa
1
