Cita de Invitado en 29 de junio de 2021, 19:15

Recientemente en un curso de Excel, me han preguntado si Excel dispone de alguna zona para guardar el formato preferido para los campos de valor, por ejemplo, que siempre que creen un campo de valor, se genere con puntuación de miles y dos decimales.

La verdad es que yo creo que a fecha de 2021 esto no puede hacerse, así que la solución que yo aporté es la de utilizar una macro que nos permita cambiar los formatos de forma rápida a todos los campos de valor que tenemos en la tabla dinámica.

Para que esto resulte más operativo, debería de guardarse esta macro en el libro personal de macros del equipo que la va a utilizar y agregarla a un botón de una cinta de opciones personalizada (o bien a la barra de acceso rápido).

Dejo el código de la macro que yo utilizo, por si puede resultar de utilidad a alguien.

Saludos,

Carlos M Tarantino

 

Sub TDIN_CAMPOS_TDINAMICA_Personalizar()
' Personaliza la Configuración de los CAMPOS de una TABLA DINAMICA

Dim TablaDinamica As String
Dim NombreTablaDinamica As String
Dim FormatoCampos As String

NombreTablaDinamica = ActiveSheet.PivotTables(1).Name ' Averiguamos el nombre la Tabla Dinámica
FormatoCampos = InputBox("Deja solo el texto del formato que quieres aplicar a los campos de valor:", "FORMATO CAMPOS VALOR", "Miles DosDecimales") ' Preguntamos sobre el Formato de los Campos Valor

Dim pt As PivotTable
Dim pf As PivotField
Dim ws As Worksheet

Set ws = ActiveSheet
Set pt = ws.PivotTables(1)

Application.ScreenUpdating = False

' Aplica los formatos numericos a cada uno de los campos de valores que tenemos en la tabla
pt.ManualUpdate = True
For Each pf In pt.DataFields
pf.Function = xlSum ' Poner la funcion suma a todos los Campos
If FormatoCampos = "DosDecimales" Then
pf.NumberFormat = "#,##0.00" ' Ponemos el formato de dos decimales
Else
pf.NumberFormat = "#,###" ' Ponemos el formato de millares sin decimales
End If

Next pf
pt.ManualUpdate = False

' Ajusta el texto de las Etiquetas de Valores Centrado (Horizontal y Vertical)
On Error Resume Next
ActiveSheet.PivotTables(NombreTablaDinamica).PivotSelect "Valores[All]", xlLabelOnly, True
With Selection
.HorizontalAlignment = xlCenter ' Centrar Horizontal
.VerticalAlignment = xlCenter ' Centrar Vertical
.WrapText = True ' Ajustar texto en la celda
End With

ActiveCell.Offset(-2, -1).Select

' Quita de las etiquetas de valores las palabras "Suma de "
pt.DataLabelRange.Replace What:="Suma de ", Replacement:=" ", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

Application.ScreenUpdating = True

Set pf = Nothing
Set pt = Nothing
Set ws = Nothing

End Sub