Excel Avanzado

Macros, Vba en Excel y muchos ejemplos de nuestro Curso de Excel Avanzado

Excel Avanzado

Grafico - Análisis de Gastos

| Sin comentarios

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.

 

bd

(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

td

(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 Subgar

(Para mayor visualización de la imagen, hacer click en la misma)

 

Click aquí para revisar los archivos:   Grafico con macros

Gráficos usando Macros

 

Por: Ruth Yakelyn

Deja una respuesta

Los campos requeridos estan marcados con *.