Archivo de la categoría: SmartArt

eliminar-todas-las-imagenes-formas-de-una-hoja-o-un-libro-en-excel-con-vba

ELIMINAR TODAS LAS IMÁGENES (FORMAS) DE UNA HOJA O UN LIBRO EN EXCEL CON VBA

Hace unos días recibí una consulta sobre cómo se podría modificar el tamaño de todas las imágenes de una hoja o de un libro mediante una macro.

Aunque este tema ha sido muy tratado en diferentes webs y foros de internet, me ha parecido útil escribir un post acerca del tratamiento de imágenes (o mejor, de cualquier objeto de la colección shapes).

Es decir, en Excel podemos estar trabajando con una fotografía, un organigrama de SmarArt, un gráfico o un objeto Ole, etc).  Todo ellos objetos que forman parte de la colección Shapes.

Siguiendo un caso práctico, imaginad que tenemos un libro con las siguientes formas (imágenes, autoformas, llamadas, objeto SmartArt):

eliminar-todas-las-imagenes-formas-de-una-hoja-o-un-libro-en-excel-con-vba

Dicho esto, si quisiéramos eliminar todos los objetos de la primera hoja de nuestro libro, lo haríamos así:

Sub Borrar_Hoja()
Dim Shape As Excel.Shapes
'Por cada forma en la hoja 1
For Each Shapes In Sheets(1).Shapes
' Eliminamos forma
With Shapes
.Delete
End With
Next
End Sub

Si quisiéramos eliminar todas las formas (Shapes) que existen el libro, tendríamos que utilizar la macro anterior pero dentro de un bucle for – next que recorra todas las hojas del libro:

Sub Borrar_Libro()
Dim nHoja As Integer
Dim Shape As Excel.Shapes
'Contamos las hojas del libro activo
nHoja = ActiveWorkbook.Worksheets.Count
'Inicimiamos bucle.
For i = 1 To nHoja
'En cada hoja seleccionamos todas las formas
For Each Shapes In Sheets(i).Shapes
'y las borramos
With Shapes
.Delete
End With
Next
Next i
End Sub

Sin embargo, si solo queremos eliminar un tipo de forma, tendríamos que especificar en el código el tipo que deseamos eliminar. Antes de seguir, os dejo un enlace a Microsoft donde se especifica el nombre y valor de todas las formas de la colección shapes:

https://msdn.microsoft.com/en-us/library/office/ff860759.aspx

eliminar-todas-las-imagenes-formas-de-una-hoja-o-un-libro-en-excel-con-vba1

*en el caso del valor 24, como observaréis, he modificado el Name que aparece publicado en Microsoft en el enlace de Microsoft (msoIgxGraphic) por (msoSmartArt), el motivo es que he probado el nombre msoIgxGraphic en todas las versiones desde 2010 en adelante y no funciona, pero sí lo hace con msoSmartArt.

Por lo tanto, para realizar la prueba vamos a elegir un tipo determinado de forma a eliminar, tanto en la primera hoja como en todo el libro. La elección serán las fotografías, que equivalen según el cuadro anterior a msoPicture y con valor 13.

Para eliminar las fotografías de la primera hoja, usaremos el siguiente código:

Sub Borrar_Hoja_Tipo()
Dim Shape As Excel.Shapes
'Por cada forma en la hoja 1
For Each Shapes In Sheets(1).Shapes
' Eliminamos forma
With Shapes
'Si la forma es entonces la borramos
If .Type = 13 Then
.Delete
End If
End With
Next
End Sub

Y para eliminar las fotografías en todo el libro, usaremos el siguiente:

Sub Borrar_Libro_Tipo()
Dim nHoja As Integer
Dim Shape As Excel.Shapes
'Contamos las hojas del libro activo
nHoja = ActiveWorkbook.Worksheets.Count
'Inicimiamos bucle.
For i = 1 To nHoja
'En cada hoja seleccionamos/detectamos todas las formas
For Each Shapes In Sheets(i).Shapes
With Shapes
'Si la forma es entonces la borramos
If .Type = 13 Then
.Delete
End If
End With
Next
Next i
End Sub

El resultado después de aplicar la macro sería este:

eliminar-todas-las-imagenes-formas-de-una-hoja-o-un-libro-en-excel-con-vba2

Y hemos eliminado las fotografías en todo el libro.

Evidentemente, podemos utilizar las macros para cualquier otro tipo de acción sobre las formas, como por ejemplo darle formato, colores, alto, ancho, etc … Pero para este ejemplo, nos hemos limitado a eliminar (en otros post que tengo pensado ir publicando iremos trabajando otras acciones).

En el archivo adjunto os dejo las macros. Sin embargo los botones que he dejado para ejecutarlas, solo son para los casos donde determinamos el tipo de forma a eliminar. Las macros que eliminan todas las formas de la hoja y del libro, si pusiese un botón en la hoja, directamente lo eliminaría, dado que también se trata de una forma (control de formulario).

Espero que os sea de utilidad 🙂

Descarga el archivo de ejemplo pulsando en: ELIMINAR TODAS LAS IMÁGENES DE UNA HOJA O UN LIBRO EN EXCEL CON VBA

CREAR ARBOL DE DECISIÓN CON SMARTART Y VBA5

CREAR ÁRBOL DE DECISIÓN CON SMARTART Y VBA

Hace unos días, un lector me comentaba que el post que había realizado sobre crear organigramas en SmartArt, también se podía adaptar para realizar un árbol de decisión. Y es cierto, de hecho las estructuras jerárquicas que aparecen en SmartArt sí que sugieren su idoneidad para crear árboles de decisión.

Por lo que hoy realizaré un pequeño ejercicio de ejemplo para comprobar cómo se adapta a un caso práctico. Recomiendo complementar la lectura de esta entrada con estos dos post:

Investigando por internet he dado con una página muy interesante sobre árboles de decisión, cuyo autor es Federico Garriga Garzón y que se titula Problemas Resueltos de Teoría de Decisión

De todos los ejercicio expuestos, he elegido el que más me ha gustado, pero podéis adaptar el que queráis. Es el ejercicio 19 y su enunciado dice así:

Una empresa está considerando la posibilidad de contratar un experto en ingeniería industrial para la planificación de su estrategia de operaciones. Una adecuada planificación supondría a la empresa unos beneficios de 1.000.000 de euros, mientras que si la planificación no fuera correctamente elaborada, la empresa estima unas pérdidas de 400.000 euros. El director industrial estima que la probabilidad de que el experto realice una adecuada planificación es del 75%. Antes de contratar al experto, la empresa tiene la opción de realizar unas pruebas para determinar la idoneidad del candidato, dichas pruebas tienen una fiabilidad del 80% a la hora de determinar el éxito potencial del candidato en la realización de la planificación de las operaciones de la empresa. Determine la decisión óptima para la empresa, así como el coste que puede asumir la empresa por realizar la prueba de idoneidad.

Pues bien, antes de comenzar y como se indica en la solución, lo primero que debemos hacer es confeccionar el árbol de decisión, solo con las decisiones, sin indicar cálculos. Tomando este ejemplo, los datos que debemos escribir para generar la estructura en gráfico serían estos:

CREAR ARBOL DE DECISIÓN CON SMARTART Y VBA2

Y ejecutando la macro (que más adelante os mostraré) generamos esta estructura:

CREAR ARBOL DE DECISIÓN CON SMARTART Y VBA1

Ahora, siguiendo los pasos del ejercicio, debemos realizar los cálculos necesarios que nos ayuden a calcular coste y el criterio para tomar una decisión óptima.

Los cálculos los realizaré en otra hoja (“CÁLCULOS”), para más información y detalle, os remito al ejercicio para consultar fórmulas, conceptos y teorías aplicadas. Estos serían los cálculos (primero mostrando las fórmulas y luego con los resultados):

CREAR ARBOL DE DECISIÓN CON SMARTART Y VBA3

CREAR ARBOL DE DECISIÓN CON SMARTART Y VBA4

Una vez que tenemos todos los datos calculados, solo tenemos que trasladarlos a la hoja (“DATOS”) e ir añadiendo información en las columnas de la derecha, así:

CREAR ARBOL DE DECISIÓN CON SMARTART Y VBA6

En la columna “D” vamos a colocar los cálculos que se refieren a las probabilidades condicionadas, las probabilidades a priori de cada acontecimiento (si es o no idóneo el candidato) y la aplicación del teorema de Bayes en función de contratar al candidato si es o no idóneo y la planificación es o no idónea), el dato irá en rojo.

En la columna “E” indicamos que si se trata de una planificación correcta, el beneficio esperado es de 1.000.000 euros y si es incorrecta las pérdidas serían de  (400.000) euros.

Finalmente en la columna “F” la calculamos directamente en la hoja (“DATOS”) resolviendo de derecha a izquierda (siguiendo el gráfico) y aplicando criterio de esperanza matemática calculando el beneficio esperado de cada decisión. Una vez realizado el cálculo para los tres nudos a la derecha, debemos colocar el resultado (beneficio) mayor en el siguiente nudo. De esta forma determinar mediante criterio de esperanza matemática entre las dos decisiones (Si es o no idóneo el candidato).

Finalmente, y como se comenta en la solución del ejercicio, dado que la última etapa es determinista, se debe elegir la alternativa cuyo beneficio sea mayor. Colocamos los resultados en azul y según cada línea de decisión.

La columna “C” hace referencia a los niveles de decisión, en este caso tenemos 4 niveles con sus nodos correspondientes.

Ahora ejecutamos esta macro para generar el árbol de decisión:

Sub ARBOL_DECISION()
Dim Diseño As SmartArtLayout
Dim Shape As Excel.Shape
Dim oNodos As SmartArtNodes
Dim i, j, Fin As Double
With Sheets("ARBOL")
.Select
'Borramos cualquier forma que se encuentre en la hoja ARBOL
For Each Shape In .Shapes
Shape.Delete
Next
'Insertamos gráfico SmartArt, recomendable utilizar el de nombre y puesto
Set Diseño = Application.SmartArtLayouts("urn:microsoft.com/office/officeart/2008/layout/NameandTitleOrganizationalChart") 'Diseño de la forma Smartart
Set Inserta = .Shapes.AddSmartArt(Diseño)
Set oNodos = Inserta.SmartArt.AllNodes
'Damos formato los colores y estilos rápidos
With Sheets("ARBOL")
For Each Shape In .Shapes
Shape.SmartArt.Color = Application.SmartArtColors("urn:microsoft.com/office/officeart/2005/8/colors/accent0_1") ' Colores disponibles
Shape.SmartArt.QuickStyle = Application.SmartArtQuickStyles("urn:microsoft.com/office/officeart/2005/8/quickstyle/3d5") 'Estilos rápidos
Next
End With
'colocamos la estructura a partir de la fila 3 y columna 1
.Shapes(1).Left = .Cells(3, 1).Left
.Shapes(1).Top = .Cells(3, 1).Top
Fin = Application.CountA(Sheets("DATOS").Range("A:A"))
'Creamos y eliminamos nodos según jerarquía y cantidad de nodos indicados en la DATOS
Do While oNodos.Count < Fin
oNodos.Add.Promote
Loop
For i = 1 To Fin
Do While oNodos(i).Level < Sheets("DATOS").Range("C" & i).Value
oNodos(i).Demote
Loop
With oNodos(i)
' Añadimos los datos de las columnas
v0 = Sheets("DATOS").Range("B" & i)
v1 = Sheets("DATOS").Range("D" & i)
v2 = Sheets("DATOS").Range("E" & i)
v3 = Sheets("DATOS").Range("F" & i)
'Contamos las palabras de cada columna
cv0 = UBound(Split(v0)) + 1
cV1 = UBound(Split(v1)) + 1
cv2 = UBound(Split(v2)) + 1
cv3 = UBound(Split(v3)) + 1
'Escribimos en cada nodo el contenido de las columnas
.TextFrame2.TextRange.Text = v0 & " " & v1 & " " & v2 & " " & v3
'Damos color (rojo y azul) a los valores de la misma forma que en el ejecicio de ejemplo
.TextFrame2.TextRange.Words(cv0 + 1, cV1).Font.Fill.ForeColor.RGB = vbRed
.TextFrame2.TextRange.Words(cv0 + cV1 + cv2 + 1, cv3).Font.Fill.ForeColor.RGB = vbBlue
End With
Next i
End With
'Formateamos el diseño del organigrama, lo presentamos con jerarquía horizontal "hierachy2"
With Sheets("ARBOL")
For Each Shape In .Shapes
Shape.SmartArt.Layout = Application.SmartArtLayouts("urn:microsoft.com/office/officeart/2005/8/layout/hierarchy2")
Next
End With
'Aumentamos zoom para ver correctamente el gráfico
ActiveWindow.Zoom = 180
'Liberamos variables
Set Diseño = Nothing
Set Inserta = Nothing
Set oNodos = Nothing
End Sub

He introducido algunas líneas de código nuevas para visualizar mejor el gráfico, (colocación y zoom) y también he implementado un pequeño sistema para colorear los ítems calculados y que forman parte del esquema.

Y el resultado es el siguiente:

CREAR ARBOL DE DECISIÓN CON SMARTART Y VBA5.jpg

Como podéis observar, el beneficio esperado es de 650.140 euros, fruto de la elección de mayor beneficio, entre “Hacer las pruebas: 650.140 euros” o “Contratar a un experto: 650.000 euros”. Es decir, el coste máximo que puede llegar a asumir la empresa para realizar las pruebas de idoneidad es de 140 euros.

Sin profundizar en los cálculos, el sentido del post es el de demostrar la posibilidad de implementar mediante SmartArt un árbol de decisión.

Por cierto, este post es el último del mes de Agosto, en breve me voy de vacaciones y estaré unos días desconectado 🙂 Nos vemos en Septiembre!!

Descarga el archivo de ejemplo pulsando en: CREAR ÁRBOL DE DECISIÓN CON SMARTART Y VBA

OBTENER NOMBRE E ID DE LOS DISEÑOS, COLORES Y ESTILOS RÁPIDOS DE SMARTART PARA VBA

Hace unos meses escribí un post acerca de las grandes posibilidades que ofrece el uso de SmartArt en vba: GENERAR ORGANIGRAMA EN SMARTART CON VBA EN EXCEL

Sin embargo y dado que estoy trabajando actualmente con otra entrada relacionada con esta temática, creo que es necesario hacer un post sobre los nombres y los ID de los diseños, los colores y los estilos rápidos que solemos utilizar en SmarArt y que son fundamentales para realizar un buen trabajo.

En la macro del post de los organigramas veíamos varias líneas de código que hacían referencia por un lado al DISEÑO:

Application.SmartArtLayouts("urn:microsoft.com/office/officeart/2008/layout/NameandTitleOrganizationalChart")

Por ejemplo, este hace referencia a un Organigrama con Título y Nombre, y hacemos referencia a su ID: "urn:microsoft.com/office/officeart/2008/layout/NameandTitleOrganizationalChart"

Pero también podríamos usar su código, que en Excel 2016 es el 89 y su nombre es Organigrama con Nombres y Puestos. Es decir que en Excel 2016 funcionaría perfectamente también así: Application.SmartArtLayouts(89)

Efectivamente, el ID siempre será el mismo en todas las versiones, mientras que el nombre (número clave) cambiará según versión. Por ese motivo siempre es más recomendable usar el ID que el nombre (a no ser que tengamos la certeza que todos los equipos en los que se ejecutará el código tengan la misma versión de Excel).

Con los colores y con los estilos rápidos sucede lo mismo, por ejemplo:

Colores:
Shape.SmartArt.Color = Application.SmartArtColors("urn:microsoft.com/office/officeart/2005/8/colors/accent0_1") 
y que podemos hacer referencia al nombre y en 2016 sería Contorno Oscuro 1 el 1, es decir: Shape.SmartArt.Color = Application.SmartArtColors(1)

Diseño Rápido:
Shape.SmartArt.QuickStyle = Application.SmartArtQuickStyles("urn:microsoft.com/office/officeart/2005/8/quickstyle/simple3") que se correspondería con el nombre Efecto Sutil código 1, y por lo tanto nos valdría poner: Shape.SmartArt.QuickStyle =Application.SmartArtQuickStyles(3)

Una vez comentado esto, os dejo una macro con la que podemos obtener tanto los nombres con los ID de cada uno de los elementos que hemos visto. De esta forma podréis obtener esta información para la versión con la que vayáis a trabajar. Este sería el código para los ID:

Sub SMARTART_ID()
Dim i As Double
With Sheets(2)
Fin = Application.CountA(.Range("A:A"))
If Fin > 0 Then Range("A1:C" & Fin).ClearContents
'Obtenemos los id de todos los diseños
Layaut = Application.SmartArtLayouts.Count
For i = 1 To Layaut
.Cells(1, 1) = "DISEÑO"
.Cells(i + 1, 1) = i & ": " & Application.SmartArtLayouts(i).ID
Next
'Obtenemos los ID de todos los colores
Colors = Application.SmartArtColors.Count
For i = 1 To Colors
.Cells(1, 2) = "COLORES"
.Cells(i + 1, 2) = i & ": " & Application.SmartArtColors(i).ID
Next
'Obtenemos el ID de todos los estilos rápidos
Styles = Application.SmartArtQuickStyles.Count
For i = 1 To Styles
.Cells(1, 3) = "ESTILOS RÁPIDOS"
.Cells(i + 1, 3) = i & ": " & Application.SmartArtQuickStyles(i).ID
Next
End With
End Sub

Para obtener los nombre solo es necesario sustituir la palabra .ID por .Name. De todas formas os dejo las dos macros en el archivo adjunto. Una vez que ejecutéis cada botón, se mostrará toda la información, en la pestaña 1 los Nombres (con su clave) y en la 2 los ID.

Listado con los ID:

OBTENER NOMBRE E ID DE LOS DISEÑOS, COLORES Y ESTILOS RAPIDOS DE SMARTART PARA VBA

Listado con el código y el nombre:

OBTENER NOMBRE E ID DE LOS DISEÑOS, COLORES Y ESTILOS RAPIDOS DE SMARTART PARA VBA1

Como siempre, espero que os sea de utilidad 🙂

Descarga el archivo de ejemplo pulsando en: OBTENER NOMBRE E ID DE LOS DISEÑOS, COLORES Y ESTILOS RÁPIDOS DE SMARTART PARA VBA

ORGANIGRAMA HORIZONTAL

GENERAR ORGANIGRAMA EN SMARTART CON VBA EN EXCEL

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