Gráficos usando Macros
ANÁLISIS DE LAS CUENTAS DE GASTOS
Las empresas deben evaluar y/o analizar el movimiento de sus partidas de gastos, ya se para elaborar el presupuesto del siguiente año, o para conocer cuáles son las partidas más relevantes y cuál es la evolución mes a mes, así la gerencia pueda tomar decisiones oportunamente y planear la manera de reducir los gastos innecesarios.
Es por ello, que con la siguiente macro mostraré que con una base de datos que nos puede arrojar cualquier sistema contable, la macro puede elaborar una tabla dinámica y gráfico.
(Para mayor visualización de la imagen, hacer click en la misma)
Para elaborar la tabla dinámica utilizaremos el siguiente código.
Sub Crear_Tabla()
Dim Hoja_1 As Worksheet
Dim Hoja_2 As Worksheet
Dim Cache_Tabla As PivotCache
Dim Tabla_Dinamica As PivotTable
Dim Rango_Tabla As Range
Dim Ultima_Fila As Long
Set Hoja_1 = Worksheets("Tabla")
For Each Tabla_Dinamica In Hoja_1.PivotTables
Tabla_Dinamica.TableRange2.Clear
Next
Set Hoja_2 = Worksheets("BD")
Ultima_Fila = Hoja_2.Cells(Rows.Count, 1).End(xlUp).Row
Set Rango_Tabla = Hoja_2.Cells(1, 1).Resize(Ultima_Fila, 12)
Sheets("BD").Select
Set Cache_Tabla = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=Rango_Tabla.Address)
Set Tabla_Dinamica = Cache_Tabla.CreatePivotTable(TableDestination:=Worksheets("Tabla").Range("A3"), TableName:="PivotTable3")
Tabla_Dinamica.Format xlReport4
Tabla_Dinamica.ManualUpdate = True
Tabla_Dinamica.AddFields RowFields:=Array("DESCRIPCION DE CUENTA"), PageFields:="MES"
With Tabla_Dinamica.PivotFields("MES")
.Orientation = xlColumnField
.Position = 1
.Name = "AÑO 2012"
End With
With Tabla_Dinamica.PivotFields("IMPORTE")
.Orientation = xlDataField
.Function = xlSum
.Position = 1
.NumberFormat = "#,##"
.Name = "Expresado en Nuevos Soles"
End With
Tabla_Dinamica.ManualUpdate = False
Sheets("Tabla").Select
End Sub
(Para mayor visualización de la imagen, hacer click en la misma)
Para que nos muestre el grafico, utilizáremos el siguiente código:
Sub Gen_Graf()
'Títulos de los gráficos
Dim aTitulo(6) As String
aTitulo(1) = "Gastos 2012"
Application.ScreenUpdating = False
fila = 1
nTablas = Worksheets("Tabla").PivotTables.Count
ActiveWindow.DisplayGridlines = False
If Worksheets("Hoja1").ChartObjects.Count > 0 Then
Worksheets("Hoja1").ChartObjects.Delete
End If
activesheet.shapes.addchart.select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlColumnClustered
Final = Sheets("Tabla").Cells(fila, 1).End(xlDown).Row
ActiveChart.SetSourceData Source:=Sheets("Tabla").Cells(fila, 1).Resize(Final - fila + 1, 7)
ActiveChart.Location Where:=xlLocationAsObject, Name:="Hoja1"
ActiveChart.HasLegend = True 'Leyenda
ActiveChart.HasPivotFields = False ' Oculta filtro de la tabla dinámica (solo si el dato proviene de una tabla dinámica)
With ActiveChart
'Titulo Principal
.HasTitle = True
.ChartTitle.Characters.Text = "EMPRESA ABC - 2012"
'Titulo Horizontal
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = aTitulo(i)
'Titulo Vertical
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Expresado en Nuevos Soles"
End With
'Atributos del Título principal
ActiveChart.ChartTitle.Select
Selection.AutoScaleFont = True
With Selection.Font
.Name = "Courier"
.Size = 16
.Bold = True
End With
'Atributos del Título vertical
ActiveChart.Axes(xlValue).AxisTitle.Select
Selection.AutoScaleFont = True
With Selection.Font
.Name = "Comic Sans"
.Size = 10
.Bold = True
End With
'Atributos del Título horizontal
ActiveChart.Axes(xlCategory).AxisTitle.Select
Selection.AutoScaleFont = True
With Selection.Font
.Name = "Arial"
.Size = 10
.Bold = True
End With
'Borde del Gráfico
With Selection.Border
.Weight = 3
.LineStyle = -1
End With
Application.ScreenUpdating = True
Call SizeGrafAct
Sheets("Hoja1").Select
End Sub
(Para mayor visualización de la imagen, hacer click en la misma)
Click aquí para revisar los archivos: Grafico con macros
Por: Ruth Yakelyn