Archivo de la etiqueta: Vba

GENERAR ORGANIGRAMA EN SMARTART CON VBA EN EXCEL

Publicado el por

Hace ya algún tiempo escribí un post sobre cómo confeccionar un organigrama en Excel, fue una entrada basada en fórmulas y teniendo como único soporte nuestra hoja Excel, de forma que antes de introducir las funciones, era necesario “dibujar” la estructura utilizando cada celda como parte del organigrama.

Hoy os propongo desarrollar un organigrama utilizando “SmartArt” en Excel (lo encontraréis en la pestaña insertar de la cinta de opciones) y con VBA.

Antes de comenzar me gustaría comentar que existe muy poca bibliografía sobre la programación en SmartArt, el desarrollo que he realizado se basa fundamentalmente en una labor de investigación y muchas pruebas, dado que apenas existen fuentes (en castellano prácticamente nada).

Vamos a utilizar un ejemplo de una empresa ficticia con 4 niveles de jerarquía. Para ello, necesitamos crear en una hoja (DISEÑO) la estructura que utilizaremos a continuación en nuestras macros. La estructura es esta:

GENERAR ORGANIGRAMA CON VBA EN EXCEL CON SMARTART

En la columna A pondremos los nombres de los departamentos (o de lo que consideremos oportuno), esta información es la que aparecerá dentro de cada “cajita” del organigrama. En la columna B el nivel de jerarquía y en la columna C (opcional, dado que solo sirve para organigramas donde existe una segunda caja para el detalle de nombre o puesto). En el ejemplo, tenemos como primer nivel: “Gerencia”(1), como segundo nivel (2), los departamentos marcados en “Azul”, como tercer nivel (3), los departamentos marcados en “Verde” y como cuarto nivel (4) los marcados en “Blanco”.

* El nivel de jerarquía siempre ha de hacer referencia a los niveles del organigrama. Los niveles debe ir en orden consecutivo, es decir 1,2,3  … y no 1, 2, 4 dado que la macro detectará que no existe el 3 y marcará un error.

Una vez que tenemos la estructura bien definida, vamos a utilizar la siguiente macro para generar nuestro primer organigrama, he elegido la forma tradicional “Organigrama con nombres y puestos” tal y como aparece en SmartArt y que en VBA se define como: “NameandTitleOrganizationalChart” (más adelante os indicaré cómo obtener la referencia de los organigramas).

La macro a utilizar es la siguiente, puede que parezca un poco extensa, pero se debe a que he intentado comentar cada una de las líneas del código para mayor comprensión:

Sub ORGANIGRAMA_VERTICAL_NOMBRE()
Dim Diseño As SmartArtLayout
Dim Shape As Excel.Shape
Dim oNodos As SmartArtNodes
Dim i, Fin As Double
With Sheets("ORG_VERTICAL")
.Select
'Limpiamos cualquier tipo de forma en la hoja2
For Each Shape In .Shapes
Shape.Delete
Next
'Creamos el organigrama partiendo siempre de un tipo concreto: /NameandTitleOrganizationalChart
Set Diseño = Application.SmartArtLayouts("urn:microsoft.com/office/officeart/2008/layout/NameandTitleOrganizationalChart")
Set inserta = .Shapes.AddSmartArt(Diseño)
Set oNodos = inserta.SmartArt.AllNodes
Fin = Application.CountA(Sheets(1).Range("A:A"))
' Mientras el numero de nodos sea inferior a las unidades del organigrama
' Seguimos creando nodos
Do While oNodos.Count < Fin
oNodos.Add.Promote
Loop
For i = 1 To Fin
'Si los niveles del organigrama son inferiores a los niveles
'indicados, eliminamos nodos.
Do While oNodos(i).Level < Sheets(1).Range("B" & i).Value
oNodos(i).Demote
Loop
'Para introducir texto y formato de cada unidad/caja/elemento del organigrama
With oNodos(i)
'Texto dentro de cada unidad
.TextFrame2.TextRange.Text = Sheets(1).Range("A" & i)
'Tamaño del texto de cada unidad
.TextFrame2.TextRange.Font.Size = 9
'Color del texto de cada unidad
.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(139, 0, 0)
'Negrita
.Shapes.Item(1).TextEffect.FontBold = msoTrue
'Color de fondo de cada unidad
.Shapes.Fill.ForeColor.RGB = vbWhite
'Color del borde de cada unidad
.Shapes.Line.BackColor.RGB = vbBlack
End With
'En el tipo de organigrama "NameandTitle" existe una segunda caja para el detalla del nombre
With oNodos(i).Shapes.Item(2)
'Texto del Nombre.
.TextFrame2.TextRange = Sheets(1).Range("C" & i)
'Color del texto
.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 139)
'Alineado (centrado)
.TextEffect.Alignment = msoTextEffectAlignmentCentered
'Tipo de letra
.TextEffect.FontName = "Calibri"
'Tamaño de letra
.TextEffect.FontSize = 10
End With
Next
'Formateamos de nuevo el organigrama creado y cambiamos a otro estilo (podemos seguir con el mismo)
'en este caso seguimos aplicando la plantilla NameandTitleOrganizationalChart
For Each Shape In .Shapes
Shape.SmartArt.Layout = Application.SmartArtLayouts("urn:microsoft.com/office/officeart/2008/layout/NameandTitleOrganizationalChart")
'Si deseamos un formato de color predeterminado, solo debemos quitar la comilla simple (') de la sentencia que sigue
'y elegir un formato (cambiando el número de referencia)
'---> 'Shape.SmartArt.Color = Application.SmartArtColors(7) '<-- aquí formateamos el color del organigrama a un estilo predefinido
'Situamos el organanigrama según necesidades y tamaño
With .Shapes(1)
.Height = 500 'Alto
.Width = 1800 'Ancho
.Top = 100 'Arriba
.Left = 100 'Izquierda
End With
Next
End With
End Sub

Lo interesante de la macro (entre otras cosas) es que vamos a aprovecharnos de las opciones de SmarArt para que construya nuestro organigrama con todo su potencial.

Siguiendo una cronología dentro de la macro, lo que hacemos primero es crear un organigrama teniendo como plantilla base: Organigrama con nombres y puestos.
Luego creamos los nodos o los eliminamos, según el tamaño de nuestra estructura, a continuación damos formato a cada una de las cajas (texto, color, bordes, etc) y en este caso, también a las segundas cajas con el detalle del nombre.

Después de tener este organigrama creado, lo que haremos, aunque en este caso no sería necesario, dado que se trata del mismo diseño, es cambiar el tipo de diseño según el organigrama o estructura que necesitemos.  Y os preguntaréis el porqué de cambiar el diseño, la respuesta es que este tipo de diseño recoge perfectamente la lógica de nuestra estructura de Excel, mientras que el resto no lo crea con la fidelidad que necesitamos (por ejemplo un organigrama de jerarquía vertical, interpreta de forma diferente la creación de los nodos en relación con la estructura definida en la hoja (DISEÑO), pero sí lo hace correctamente si cambiamos el diseño si ha sido creado con tipo Organigrama con nombres y puestos (también valdría Organigrama Horizontal), pero siempre la primera plantilla debe ser un organigrama.

Por todo ello, para cambiar el tipo de organigrama o forma, debemos modificar la parte del código que está en rojo, insertando la referencia a la estructura elegida.

El resultado sería el siguiente en SmartArt, (una vez que ejecutéis la macro):

ORGANIGRAMA VERTICAL

Siguiendo con los ejemplos vamos a generar un segundo tipo de organigrama, ahora Organigrama Horizontal, para ello, utilizamos la macro anterior pero tendremos que hacer modificaciones:

Sub ORGANIGRAMA_HORIZONTAL()
Dim Diseño As SmartArtLayout
Dim Shape As Excel.Shape
Dim oNodos As SmartArtNodes
Dim i, Fin As Double
With Sheets("ORG_HORIZONTAL")
.Select
'Limpiamos cualquier tipo de forma en la hoja3
For Each Shape In .Shapes
Shape.Delete
Next
'Creamos el organigrama partiendo siempre de un tipo concreto: /NameandTitleOrganizationalChart
Set Diseño = Application.SmartArtLayouts("urn:microsoft.com/office/officeart/2008/layout/NameandTitleOrganizationalChart")
Set inserta = .Shapes.AddSmartArt(Diseño)
Set oNodos = inserta.SmartArt.AllNodes
Fin = Application.CountA(Sheets(1).Range("A:A"))
' Mientras el numero de nodos sea inferior a las unidades del organigrama
' Seguimos creando nodos
Do While oNodos.Count < Fin
oNodos.Add.Promote
Loop
For i = 1 To Fin
'Si los niveles del organigrama son inferiores a los niveles
'indicados, eliminamos nodos.
Do While oNodos(i).Level < Sheets(1).Range("B" & i).Value
oNodos(i).Demote
Loop
'Para introducir texto y formato de cada unidad/caja/elemento del organigrama
With oNodos(i)
'Texto dentro de cada unidad
.TextFrame2.TextRange.Text = Sheets(1).Range("A" & i)
'Tamaño del texto de cada unidad
.TextFrame2.TextRange.Font.Size = 10
'Negrita
.Shapes.Item(1).TextEffect.FontBold = msoTrue
'Color de fondo de cada unidad
End With
Next
'Formateamos de nuevo el organigrama creado y cambiamos a otro estilo (podemos seguir con el mismo)
'en este caso aplicamos "HorizontalOrganization"
For Each Shape In .Shapes
Shape.SmartArt.Layout = Application.SmartArtLayouts("urn:microsoft.com/office/officeart/2009/3/layout/HorizontalOrganizationChart")
Shape.SmartArt.Color = Application.SmartArtColors(5) '<-- aquí formateamos el color del organigrama a un estilo predefinido
'Situamos el organanigrama según necesidades y tamaño
With .Shapes(1)
.Height = 1000 'Alto
.Width = 1300 'Ancho
.Top = 100 'Arriba
.Left = -50 'Izquierda
End With
Next
End With
End Sub

En primer lugar no necesitamos dar formato a las segundas “cajas” (nombres) dado que este diseño nos las tiene. En segundo lugar, y subrayado en rojo, cambiamos el diseño del organigrama a “HorizontalOrganizationChart”. Aprovecho también para utilizar los estilos de color predefinidos (así no necesitamos dar formato de color a las cajas):

Shape.SmartArt.Color = Application.SmartArtColors(5) , (luego os indicaré cómo encontrar la referencia para cada color).

El resultado es este:

ORGANIGRAMA HORIZONTAL

Ahora vamos a generar un segundo tipo de estructura: la jerarquía. Y crearemos una estructura de Jerarquía Vertical y Horizontal, empezamos con la Vertical:

Aquí tenemos la macro:

Sub JERARQUIA_VERTICAL()
Dim Diseño As SmartArtLayout
Dim Shape As Excel.Shape
Dim oNodos As SmartArtNodes
Dim i, Fin As Double
With Sheets("JERARQUIA_VERTICAL")
.Select
'Limpiamos cualquier tipo de forma en la hoja4
For Each Shape In .Shapes
Shape.Delete
Next
'Creamos el organigrama partiendo siempre de un tipo concreto: /NameandTitleOrganizationalChart
Set Diseño = Application.SmartArtLayouts("urn:microsoft.com/office/officeart/2008/layout/NameandTitleOrganizationalChart")
Set inserta = .Shapes.AddSmartArt(Diseño)
Set oNodos = inserta.SmartArt.AllNodes
Fin = Application.CountA(Sheets(1).Range("A:A"))
' Mientras el numero de nodos sea inferior a las unidades del organigrama
' Seguimos creando nodos
Do While oNodos.Count < Fin
oNodos.Add.Promote
Loop
For i = 1 To Fin
'Si los niveles del organigrama son inferiores a los niveles
'indicados, eliminamos nodos.
Do While oNodos(i).Level < Sheets(1).Range("B" & i).Value
oNodos(i).Demote
Loop
'Para introducir texto y formato de cada unidad/caja/elemento del organigrama
With oNodos(i)
'Texto dentro de cada unidad
.TextFrame2.TextRange.Text = Sheets(1).Range("A" & i)
'Tamaño del texto de cada unidad
.TextFrame2.TextRange.Font.Size = 9
End With
Next
'Formateamos de nuevo el organigrama creado y cambiamos a otro estilo (podemos seguir con el mismo)
'en este caso aplicamos "JERARQUÍA VERTICAL"
For Each Shape In .Shapes
Shape.SmartArt.Layout = Application.SmartArtLayouts("urn:microsoft.com/office/officeart/2005/8/layout/hierarchy1")
Shape.SmartArt.Color = Application.SmartArtColors(4) '<-- aquí formateamos el color del organigrama a un estilo predefinido
Shape.SmartArt.QuickStyle = Application.SmartArtQuickStyles(4) '<-- aquí formateamos el estilo del organigrama a un estilo predefinido
'Situamos el organanigrama según necesidades y tamaño
With .Shapes(1)
.Height = 500 'Alto
.Width = 2500 'Ancho
.Top = 100 'Arriba
.Left = 100 'Izquierda
End With
Next
End With
End Sub

Añadimos el nuevo diseño (subrayado en rojo): hierarchy1 (jerarquía vertical), también vamos a elegir una paleta de colores predefinidas:
Shape.SmartArt.Color = Application.SmartArtColors(4)
y como novedad, aplicamos un estilo rápido, que nos ofrece la posibilidad la cinta de opciones:
Shape.SmartArt.QuickStyle = Application.SmartArtQuickStyles(4)

y este es el resultado:

JERARQUIA VERTICAL

Ahora generaremos una estructura de jerarquía horizontal: “hierarchy2” que es idéntica a la anterior pero modificando diseño, estilo y colores:

Sub JERARQUIA_HORIZONTAL()
Dim Diseño As SmartArtLayout
Dim Shape As Excel.Shape
Dim oNodos As SmartArtNodes
Dim i, Fin As Double
With Sheets("JERARQUIA_HORIZONTAL")
.Select
'Limpiamos cualquier tipo de forma en la hoja5
For Each Shape In .Shapes
Shape.Delete
Next
'Creamos el organigrama partiendo siempre de un tipo concreto: /NameandTitleOrganizationalChart
Set Diseño = Application.SmartArtLayouts("urn:microsoft.com/office/officeart/2008/layout/NameandTitleOrganizationalChart")
Set inserta = .Shapes.AddSmartArt(Diseño)
Set oNodos = inserta.SmartArt.AllNodes
Fin = Application.CountA(Sheets(1).Range("A:A"))
' Mientras el numero de nodos sea inferior a las unidades del organigrama
' Seguimos creando nodos
Do While oNodos.Count < Fin
oNodos.Add.Promote
Loop
For i = 1 To Fin
'Si los niveles del organigrama son inferiores a los niveles
'indicados, eliminamos nodos.
Do While oNodos(i).Level < Sheets(1).Range("B" & i).Value
oNodos(i).Demote
Loop
'Para introducir texto y formato de cada unidad/caja/elemento del organigrama
With oNodos(i)
'Texto dentro de cada unidad
.TextFrame2.TextRange.Text = Sheets(1).Range("A" & i)
'Tamaño del texto de cada unidad
.TextFrame2.TextRange.Font.Size = 9
End With
Next
'Formateamos de nuevo el organigrama creado y cambiamos a otro estilo (podemos seguir con el mismo)
'en este caso aplicamos "JERARQUÍA HORIZONTAL"
For Each Shape In .Shapes
Shape.SmartArt.Layout = Application.SmartArtLayouts("urn:microsoft.com/office/officeart/2005/8/layout/hierarchy2")
Shape.SmartArt.Color = Application.SmartArtColors(14) '<-- aquí formateamos el color del organigrama a un estilo predefinido
Shape.SmartArt.QuickStyle = Application.SmartArtQuickStyles(3) '<-- aquí formateamos el estilo del organigrama a un estilo predefinido
'Situamos el organanigrama según necesidades y tamaño
With .Shapes(1)
.Height = 1000 'Alto
.Width = 800 'Ancho
.Top = 100 'Arriba
.Left = -50 'Izquierda
End With
Next
End With
End Sub

Este es el resultado:

JERARQUIA HORIZONTAL

 Y para finalizar, os agrego un organigrama horizontal pero en 3D, con el código similar a los anteriores, donde modificamos estilo (en este caso en 3D) y colores.

Sub ORGANIGRAMA_3D_HORIZONTAL()
Dim Diseño As SmartArtLayout
Dim Shape As Excel.Shape
Dim oNodos As SmartArtNodes
Dim i, Fin As Double
With Sheets("ORG_3DHORIZONTAL")
.Select
'Limpiamos cualquier tipo de forma en la hoja6
For Each Shape In .Shapes
Shape.Delete
Next
'Creamos el organigrama partiendo siempre de un tipo concreto: /NameandTitleOrganizationalChart
Set Diseño = Application.SmartArtLayouts("urn:microsoft.com/office/officeart/2008/layout/NameandTitleOrganizationalChart")
Set inserta = .Shapes.AddSmartArt(Diseño)
Set oNodos = inserta.SmartArt.AllNodes
Fin = Application.CountA(Sheets(1).Range("A:A"))
' Mientras el numero de nodos sea inferior a las unidades del organigrama
' Seguimos creando nodos
Do While oNodos.Count < Fin
oNodos.Add.Promote
Loop
For i = 1 To Fin
'Si los niveles del organigrama son inferiores a los niveles
'indicados, eliminamos nodos.
Do While oNodos(i).Level < Sheets(1).Range("B" & i).Value
oNodos(i).Demote
Loop
'Para introducir texto y formato de cada unidad/caja/elemento del organigrama
With oNodos(i)
'Texto dentro de cada unidad
.TextFrame2.TextRange.Text = Sheets(1).Range("A" & i)
'Tamaño del texto de cada unidad
.TextFrame2.TextRange.Font.Size = 11
'Negrita
.Shapes.Item(1).TextEffect.FontBold = msoTrue
'Color de fondo de cada unidad
End With
Next
'Formateamos de nuevo el organigrama creado y cambiamos a otro estilo (podemos seguir con el mismo)
'en este caso aplicamos "HorizontalOrganization" en 3D
For Each Shape In .Shapes
Shape.SmartArt.Layout = Application.SmartArtLayouts("urn:microsoft.com/office/officeart/2009/3/layout/HorizontalOrganizationChart")
Shape.SmartArt.Color = Application.SmartArtColors(1) '<-- aquí formateamos el color del organigrama a un estilo predefinido
Shape.SmartArt.QuickStyle = Application.SmartArtQuickStyles(11) '<-- aquí formateamos el estilo del organigrama a un estilo predefinido, 3D
'Situamos el organanigrama según necesidades y tamaño
With .Shapes(1)
.Height = 1000 'Alto
.Width = 1500 'Ancho
.Top = 100 'Arriba
.Left = 100 'Izquierda
End With
Next
End With
End Sub

Este sería el resultado:

ORGANIGRAMA 3DHORIZONTAL

Ahora os explico cómo obtener algunas de las referencias con las que hemos trabajado.

El diseño de la estructura o forma: esto lo podéis ver, si utilizáis el grabador de macros e insertáis la forma de SmartArt que busquéis. La referencia siempre entre paréntesis y comienza por “urn:microsoft.com” este es un ejemplo: “urn:microsoft.com/office/officeart/2005/8/layout/hierarchy2”

Los colores y estilos predefinidos:
teniendo en cuenta que la línea de código para elegir color y estilo

Shape.SmartArt.Color = Application.SmartArtColors(14)

Shape.SmartArt.QuickStyle = Application.SmartArtQuickStyles(3)

Color (14) y estilo (3), debemos pulsar encima del organigrama o forma creada y se abrirán dos pestañas nuevas en nuestra cinta de opciones, “Herramientas de SmartArt” y entramos en Diseño. Si queremos elegir un color, por ejemplo el 14, pulsamos en “Cambiar Colores” y dentro del desplegable, vamos contando desde el primero (1) hasta que hayamos elegido en este caso el 14. Y haremos lo mismo con el estilo rápido, que es el desplegable de justo al lado, en este caso el 3.

Estilos y colores

**Las macros funcionan perfectamente en Excel 2010 y 2016, no he probado en 2013 pero deberían funcionar correctamente. En Excel 2007 y anteriores la macro no funcionará.

El límite de creación de “cajas” (nodos) es ilimitado, sin embargo, el dar formato a los estilos de línea o a los estilos de relleno. El motivo es la colección shapes tiene un límite definido de 256. Es decir que si queréis crear una estructura de más de 256 elementos tendrías que modificar la macro y quedaros solo con la parte del código que ingresa el nombre de los departamentos, sin hacer referencia al objeto shape.

Os dejo un archivo con cinco botones vinculados a cinco hojas que al pulsarlos crean el organigrama. El tiempo de ejecución de cada macro variará en función del tamaño de estructura a crear, en estos ejemplos es de una media de 45 segundos.

El post se podría extender mucho más, pero creo que para recoger la idea y de ver cómo funcionan las macros es suficiente. Os invito a probéis a modificar los diseños y tipos de estructuras, estoy seguro que lo disfrutareis.

Por otra parte, es una forma muy profesional de mantener la estructura o el organigrama de una organización, evitando tener que pasar horas y horas frente al PowerPoint confeccionando cajas.

Pues este ha sido el post de la semana, espero (y estoy seguro que sí), que os sea de utilidad 🙂

Descarga el archivo de ejemplo pulsando en: GENERAR ORGANIGRAMA EN SMARTART CON VBA EN EXCEL

 

Anuncios