Automatizando la generacion graficos excel - vba

Solo disponible en BuenasTareas
  • Páginas : 6 (1397 palabras )
  • Descarga(s) : 0
  • Publicado : 29 de enero de 2011
Leer documento completo
Vista previa del texto
AUTOMATIZANDO LA GENERACION DE GRAFICOS EN EXCEL 2007 CON VBA

El propósito de este documento es mostrar el código escrito en Excel 2007 utilizando VBA, con el cual podremos personalizar la presentación y actualización de grafico en Excel, evitando la ediciones manuales que mucho tiempo nos consume para esas tareas repetitivas, como son, ajustar la escala de visualización de los gráficos(barras, lineales, etc), desplazar los objetos incrustados en los gráficos para que estén perfectamente armonizados y se presenten exactamente al final de las barras.
Y finalmente como si se tratase de la cereza que adorna al postre, mostramos el código que captura la plantilla del grafico a trabajar, la copia en otra hoja y recorta dicha imagen mostrando solamente la porción de espacio pertenecienteal grafico que deseamos evidenciar.
Con la creación de este código, hemos logrado que en nuestras tareas diaria, ahorremos muchas horas hombres que se invertían para estos pequeños ajustes, los cuales no eran nada complejos pero invertían buena cantidad de tiempo.
Espero sea de utilidad y cualquier consulta pueden contactarme a mi correo percyher@hotmail.com
Saludos
Percy Herrera M.Plantilla que nos servirá para la demostración del código.
Esta plantilla está vinculado a una o más tablas dinámicas las cuales al ser actualizadas o ajustar las variables, la información que este muestra, cambia y por ende el grafico también, pero las escalas no se ajustan automáticamente ni los objetos (elipses) que están a la derecha que cada barra.
El código mostrado a continuación tiene estepropósito.

Public MyName As String

Sub Borrar_Vacios()

Dim x As String
Dim found As Boolean

Range("A35:W42").Select
Selection.Copy
Range("A44").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False


Range("B44").Select


Do UntilIsEmpty(ActiveCell)
Do Until IsEmpty(ActiveCell)
If ActiveCell = 0 Then
Selection.ClearContents 'borra el contenido
End If

ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(-8, 1).Select
Loop

Modificar_Escala
color_Formas
mover_Burbuja
PrintScreen

End Sub

SubModificar_Escala()

Dim MaxBelcorp As Double
Dim MaxEsika As Double
Dim MaxCy As Double
Dim MaxLbel As Double
Dim MaxUnique As Double
Dim MaxAvon As Double
Dim MaxNatura As Double
Dim Maximo As Double

'Hallando el valor Maximo Primer Grafico
Worksheets("Total").Activate
Maximo = Application.WorksheetFunction.Max(Range("E25:F32"))'Hallando el valor Maximo
Worksheets("Meses").Activate

MaxBelcorp = Application.WorksheetFunction.Max(Range("B45:AA45"))
MaxEsika = Application.WorksheetFunction.Max(Range("B46:AA46"))
MaxCy = Application.WorksheetFunction.Max(Range("B47:AA47"))
MaxLbel = Application.WorksheetFunction.Max(Range("B48:AA48"))
MaxAvon =Application.WorksheetFunction.Max(Range("B49:AA49"))
MaxUnique = Application.WorksheetFunction.Max(Range("B50:AA50"))
MaxNatura = Application.WorksheetFunction.Max(Range("B51:AA51"))

'Hallando el valor Minimo
MinBelcorp = Application.WorksheetFunction.Min(Range("B45:AA45"))
MinEsika = Application.WorksheetFunction.Min(Range("B46:AA46"))
MinCy = Application.WorksheetFunction.Min(Range("B47:AA47"))
MinLbel =Application.WorksheetFunction.Min(Range("B48:AA48"))
MinAvon = Application.WorksheetFunction.Min(Range("B49:AA49"))
MinUnique = Application.WorksheetFunction.Min(Range("B50:AA50"))
MinNatura = Application.WorksheetFunction.Min(Range("B51:AA51"))

'Activar "Grafico"
Worksheets("Grafico").Activate

'Grafico TOTAL
ActiveSheet.ChartObjects("1...
tracking img