3 marzo, 2021

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

 

Comparte este post

66 comentario en “GENERAR ORGANIGRAMA EN SMARTART CON VBA EN EXCEL

  1. Me parece una idea original y estupenda, pero me he descargado el fichero y he sido incapaz de ver como funciona.
    Cuando pulso un boton para ver como se genera el organigrama me surge un mensaje de error que dice «no se ha definido el tipo definido por el usuario» ¿Es compatible con office 2007?
    No obstante, muchas gracias por el post

    1. Hola ftmj,

      Efectivamente es problema de la versión de excel. En concreto en la versión 2007 todavía no se había implementando el objeto SmartArtLayout, y eso es lo que ocasiona el error de funcionamiento. la macro funciona en 2010, 2013 y 2016 sin problemas.

      Saludos!! y gracias por comentar!

  2. Hola como estas, como podría hacer si por cada una de las cajas necesito pintarlas de un color diferente, es decir en una columna adicional si es 1, pinto la caja de color rojo, si es 2 de azul y así sucesivamente. podrías ayudarme.

    1. Hola Miguel,

      Claro que se puede, simplemente hay que introducir unos condicionales en el código y eliminar la parte que hace referencia al color interior y saldrá perfectamente. En concreto, en la parte que hace referencia a las cajas principales oNodos(i) incluir esto:

      If Sheets("DISEÑO").Cells(i, 4) = 1 Then .Shapes.Fill.ForeColor.RGB = RGB(226, 107, 10) 'naranja
      If Sheets("DISEÑO").Cells(i, 4) = 2 Then .Shapes.Fill.ForeColor.RGB = vbGreen 'verde
      If Sheets("DISEÑO").Cells(i, 4) = 3 Then .Shapes.Fill.ForeColor.RGB = vbBlue 'azul
      If Sheets("DISEÑO").Cells(i, 4) = vbNullString Then .Shapes.Fill.ForeColor.RGB = vbWhite ' si no hay numero en blanco

      Te envío el archivo por correo.

      Saludos.

      1. Hola, como estas?

        He intentado seguir las indicaciones que das para cambiar el color de un nodo basado en el numero de una columna adicional, así tal como muestras, pero le he dado muchas vueltas y horas y no lo consigo.

        Dentro de la parte: With oNodos(i)

        Trato en esta parte de usar el condicional que muestras arriba, el smartart se genera correctamente, pero no veo el cambio de color.

        Me puedes ayudar con esta duda por fa.

        Un saludo

        1. Hola DannyR.

          Tendría que ver un ejemplo de tu código y tu archivo para poder ayudarte. Envía una ejemplo (explicando qué es lo que no te funciona y lo que necesitas). excelsignum@gmail.com

          El archivo que te envíe en su momento funcionaba correctamente, por eso necesito ver tu ejemplo.

          Saludos.

          1. Hola Segu,

            Mil gracias por tu apoyo.

            Segu, logre resolver el tema de cambiar el color de un nodo basado en el numero, ya me funciona bien, muchas gracias por tu código.

            Ahora bien, todo me funciono bien hasta que el smartart creció mucho, tengo información de la linea 1 hasta la linea 130 y la macro se demora entre 15-20 minutos y al final me da error.

            Con menos lineas de información funciona super bien… pero ahora no se… necesitaba que graficara hasta unas 200 lineas del excel 🙁

            Saludos
            DannyR

          2. Hola Danny:

            Si utilizas el modelo de organigrama con «Nombres y Puestos», tiene una limitación de 256 elementos, aunque si en tu proyecto estamos hablando de menos (200) no debería surgir ningún tipo de error… si lo hace seguramente se debe a otro motivo.

            Sobre la lentidud de la macro, pues dificilmente se puede mejorar, ten en cuenta que estás creando multitud de elementos y que además se van adaptando a la propia hoja. Una alternativa sería que lo generases por áreas, así generarías más rápidamente la estructura.

            Sobre el error, tendría que ver el archivo para verificar cuál podría ser el problema.

            Saludos!

  3. Hola, muchísimas gracias por el post, tal y como dices me ha sido de mucha utilidad. Yo no tengo ni idea de macros pero está explicado tan bien que hasta yo he sido capaz de hacerlo. Sin embargo me gustaría saber si me podrías ayudar con hacer uno como JERARQUIA_VERTICAL pero con el campo nombre también dentro de una caja tal y como haces en ORG_VERTICAL. Yo he intentado mezclar los dos macros para conseguirlo pero he probado cincuenta maneras y siempre me ha dado error.

    1. Hola Amaia

      Me alegro que te resulte útil el post. La duda que comentas no tiene fácil solución, dado que el único organigrama que tiene una segunda caja ( en el ejemplo) para el nombre, no es válido para otras estructuras ni jerarquía horizontal ni vertical. La unica solución sería concatenar el puesto o departamento con el nombre, pero pintando todo dentro de la misma caja. Diferenciando los elementos con colores: ejemplo nombre y puesto o departamento.

      De todas formas estoy de vacaciones ( te estoy contestando por movil) a la vuelta intentamos buscar alguna otra alternativa 🙂

      Saludos!!

  4. Excelente post, me ha sido muy útil, yo completo las cajas del organigrama con los datos de una celda que concatena los datos en otras celdas, por lo que la celda siempre tiene la fórmula y me crea cajas vacias, podrías ayudarme como hacer para que si la celda está vacía (aunque con la fórmula escrita en ella) no genere la caja, logré explicarme?, te lo agradecería mucho, saludos

    1. Hola Otto:

      Antes de contestar, podrías enviar a excelsignum@yahoo.es un ejemplo del problema que necesitas solucionar, es decir con los datos inventado y la formula sin datos que hace que te genere un nuevo nodo. Así podré aportar una solución precisa.
      Muchas gracias por enviar la consulta.

      Saludos.

      1. Eres un Crack! muchas gracias por el tiempo y análisis que le dedicaste a mi consulta, ese último archivo me será muy útil, saludos y éxitos!!

  5. Hola buenos días, lo primero de todo agradecerte por tu dedicación y decirte que la macro funciona correctamente, y que me ha sido de una gran utilidad, solo una duda, este macro está planteada para 4 niveles de jerarquía, que pasaría si fueran necesarios 5 niveles de jerarquía??un saludo, y de nuevo muchísimas gracias

    1. Hola Javier:

      En el post indico que puedes agregar más niveles de desarrollo. De hecho en la columna B es donde debes indicar esos niveles. En el ejemplo está hasta el nivel 4 pero podría ser 5, 6 7 etc. Los niveles deben ser consecutivos en cada dependencia y de menor a mayor en cada NODO o departamento.

      Saludos.

  6. Enhorabuena por las macros!!! Funcionan de maravilla.
    La puntilla sería que se añadiera una columna más con el nombre de las imágenes y que se fuera a buscarlas a un directorio para no tener que agregarlas una a una.

    Saludos.

  7. Hola Segu
    La macro es excelente, como hago para cambiar el tamaño de las formas (shapes) que llevan los nombres dentro del smartart? Luego, estoy utilizando orgChart1 y necesito que los dependientes se dividan a ambos lados y no solo en una linea hacia abajo

    1. Hola Edgardo, inténtalo utilizando las propiedades

      .Height = 1000 ‘Alto
      .Width = 1300 ‘Ancho
      .Top = 100 ‘Arriba
      .Left = -50

      En cada Shape.

      Sobre el tema de modificar las dependencias, la macro solo realiza el desarrollo automático de creación del organigrama. Tendría que ver si es posible programar esa parte.

      Saludos

  8. La primera macro me ha encantado, es justo lo que necesitaba, pero me surgen un par de dudas:
    1- Si quiero insertar una fila con los títulos describiendo cada uno de los campos (Es decir celda a1=Puesto celda b1=Rango celda c1=Nombre), como debo modificar el código de la macro para que dicha línea de titulos no forme parte del organigrama
    2- Como debo modificar para que el organigrama en smartart se presente en una hoja adicional y no sobre la misma hoja con los datos?

    Muchas gracias

    1. Hola Vasconcellos:

      Para agregar más información debes concatenar los datos, por ejemplo así, con las columnas A, B, C:

      .TextFrame2.TextRange.Text = Sheets(1).Range(«A» & i) & Sheets(1).Range(«B» & i) & Sheets(1).Range(«C» & i)

      Sobre la segunda pregunta, los organigramas ya se presentan en una hoja adicional, esto se lo indicas al inicio de la macro:

      With Sheets(«ORG_3DHORIZONTAL»)

      Es decir que es aquí donde especificas la hoja en la que quieres que se muestre el organigrama.

      Saludos.

  9. Muchas gracias, respecto a la primera cuestión, lo que realmente necesitaba es que el código ejecute a partir de la segunda línea (es decir desde la celda a2 en adelante) y dejar la celda a1, b1 y c1 para escribir un encabezado.

    1. OK:

      Pues debes modificar la macro para realizarlo. Te pongo el ejemplo con el organigrama en 3D:

      Si le pones títulos lo generará sin problema.

      Saludos

      Sub JERARQUIA_POR_AREAS()
      'Declaramos variables
      Dim Diseño As SmartArtLayout
      Dim Shape As Excel.Shape
      Dim oNodos As SmartArtNodes
      Dim i As Integer, Fin As Integer
      With Sheets("ESTRUCTURA")
      .Select
      'Eliminamos TODOS objetos en la hoja "ESTRUCTURA"
      For Each Shape In .Shapes
      Shape.Delete
      Next
      'Insertamos objeto SmartArt, en este caso "Jerarquía de tabla"
      Set Diseño = Application.SmartArtLayouts("urn:microsoft.com/office/officeart/2005/8/layout/hierarchy4")
      Set inserta = .Shapes.AddSmartArt(Diseño)
      Set oNodos = inserta.SmartArt.AllNodes
      'Verificamos número de nodos necesarios contando los ítems de la página "DATOS"
      Fin = Application.CountA(Sheets("DATOS").Range("A:A"))
      'Creamos nodos
      Do While oNodos.Count < Fin
      oNodos.Add.Promote
      Loop
      'Eliminamos nodos sobrantes y los nombramos con la información de la hoja "DATOS"
      For i = 2 To Fin
      Do While oNodos(i - 1).Level < Sheets("DATOS").Range("B" & i).Value
      oNodos(i - 1).Demote
      Loop
      With oNodos(i - 1)
      .TextFrame2.TextRange.Text = Sheets("DATOS").Range("A" & i)
      End With
      Next
      'Eliminamos último nodo (estará vacío al tener encabezado la hoja "DATOS")
      oNodos(Fin).Delete
      'aplicamos estilos
      For Each Shape In .Shapes
      'Colores
      Shape.SmartArt.Color = Application.SmartArtColors("urn:microsoft.com/office/officeart/2005/8/colors/accent2_1")
      'Estilos rápidos
      Shape.SmartArt.QuickStyle = Application.SmartArtQuickStyles("urn:microsoft.com/office/officeart/2005/8/quickstyle/simple2")
      'Dimensionamos la imagen
      With .Shapes(1)
      .Height = 581.25 'Alto del objeto
      .Width = 1375.5 'Ancho del objeto
      .Top = 6.749921 ' Altura en la hoja
      .Left = 14.25 ' A la izquierda de la hoja
      End With
      Next
      End With
      End Sub

  10. Hola,
    primero y antes de todo, te felicito por este gran trabajo.
    Yo estoy creando un organigrama con los nombres de los planos de difusion que realizo para cada obra.
    Mi pregunta, es la siguiente,
    como puedo decirle que Cuando ponga zero en el nivel de jerarquia que no aparezca en mi organigrama.
    Quiero agregar esta opcion porque mi organigrama cambia con cada obra y quiero usar la misma base de datos y solo cambiar los niveles.

    No se si me he explicado bien.

    Muchas gracias.
    Un saludo

    1. Hola Haby:

      Lo que consultas es muy complejo, dado que el código realizar la promoción de nodos de forma automática y siguiendo una jerarquía, si esta se rompe o se alterada por un nulo o se decide eliminar, solo se podría realizar en el momento de la creación y de existir nodos dependientes estos asumirían una nueva dependencia no determinada.

      En resumen, aunque lo voy a estudiar, es una tarea muy compleja y que dudo se pueda realizar satisfactoriamente.

      Saludos.

  11. hola me encanta, pero en mi caso, la estructura que quiero adaptar tiene departamentos de nivel 4 por ejemplo con dependecia directa de un nivel mas superior , ejemplo un departamento nivel 4 dependiente del 2, o varios dptos (directores) nivel 3 con dependencia al gerenciamiento 1. como puedo addaptar?

    1. Hola Verónica:

      Eso no lo permite la programación de SmartArt, de forma predeterminada. Solo puedes crear estructuras con dependencias ordenadas, es decir no puede crear una dependencia de un nivel 1 con un 7.

      Es unas de las limitaciones de SmartArt. Podrías indicarlo dichas dependencias con colores, por ejemplo, de forma que se diferenciasen y con un texto aclaratorio.

      Saludos

  12. Hola, muy bueno el aporte.
    Una consulta; como podria cambiar el diseño del organigrama? creo que lo indicas con el /NameandTitleOrganizationalChart verdad? y si quiero otro? de donde obtengo su nombre? gracias

  13. Hola como puedo cambiar el tamaño de la segunda caja (en donde va el nombre) de tal manera que encaje los datos que he llenado, que son relativamente extenso.
    Asi mismo agradecerte porque la herramienta que aportes, mil mil gracias.

    1. Hola Richard:

      Para hacer lo que indicas, debes modificar el tamaño de la LETRA de la segunda caja y aumentar el tamaño general del organigrama. En el código tienes esos dos elementos y solo tienes que modificarlos.

      Saludos.

    1. Hola segu,

      Yo necesito hacer un organigrama de 1000 empleados, pero NO te entendí qué es lo que debo cambiar en la macro, me ayudas por favor?

  14. Hola, buen día.
    Excelente trabajo, muchas gracias.

    Existe algún SAMRART de organigrama con 3 cajas? Es decir, requiero que la macro ademas de arrogar el valor de nombre y cargo también me de otro valor de otra columna:
    1.- El nombre – Columna A
    2.- El cargo Columna B
    3.- Ciudad – Columna C

    ¿cómo puedo lograrlo?

  15. Otra duda, estoy corriendo la macro, tengo hasta 7 niveles en la jerarquía. La macro corre y me arroja el organigrama pero sale sin datos, no se ven los nombres ni cargos.

    ¿Qué puedo hacer?

  16. Hola Eduardo:

    El organigrama en SMARTART unicamente tiene 2 cajas, si necesitas introducir más información, lo único es concatenar dos columnas y colocar la info en la caja que consideres.

    Respecto a los 7 niveles, verifica que la estructura que estás creando sigue los parámetros que te indico en el ejemplo del post, sobre todo en los niveles de jerarquía. Analízalo detenidamente.

    Saludos.

    1. Muchas gracias, no encontré el error pero generé nuevamente la macro y funciono muy bien.
      Otra pregunta, me gustaría poder hacer que los datos para la segunda caja respetaran el formato de origen, incluyendo diferentes colores en cada letra.

      Se puede hacer con condicionantes?
      Podemos organizar una telco para platicar mejor?

      Excelente tarde.

      1. Hola Eduardo:

        No puedo realizar telco. Pero a la pregunta que indicas, si observas el código del organigrama con nombres y títulos verás esto:

        '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

        Es aquí donde debes realizar las modificaciones.

  17. Lo que deseo realizar específicamente es lo siguiente:

    Tengo las celdas concatenadas:

    With NumCargos(i – 1).Shapes.Item(2)

    .TextFrame2.TextRange = Sheets(1).Range(«D» & i) & Sheets(1).Range(«E» & i) & Sheets(1).Range(«F» & i) & Sheets(1).Range(«G» & i) & Sheets(1).Range(«H» & i) ‘Texto de atributos.

    Depende el valor de cada rango (D,E,F,G) será el color de su letra, ejemplo:

    Si viéramos ya la celda concatenada diría: SD48
    Me gustaría que:
    – La letra S saliera en rojo
    – La letra D saliera verde
    -El numero 4 naranja
    – El numero 8 azul.

  18. O bien, si es posible poder contar con una formula para que al concatenar los valores respete el formato y color de origen de cada celda a concatenar.

  19. Hola Eduardo:

    Últimamente no tengo tiempo para realizar consultoría, me estoy recuperando de un problema de salud grave. No obsante si me envías una pequeña muestra de lo que tienes y cómo quieres que quede o se comporte, lo podría analizar.

    Pero lo que me envíes debe estar bien explicado y con ejemplo de como está los datos y cómo deben quedar.

    Saludos.

    1. Hola Pascual:

      La forma de cada organigrama de SmarArt está predeterminada. No es posible generar las jerarquías con un círculo, donde además se producirían descuadres. Se programa con SmartArtNodes y por lo que veo el objeto no admiten al cambio de forma.

      Saludos.

  20. Bueno días! El código funciona perfectamente. Intenté con aproximadamente 30 unidades y todo va bien pero la realidad es que necesito trabajar con alrededor de 140 en ese caso excel deja de responder y ya no se ejecuta la macro correctamente. Como podría plantearlo por módulos? Por ejemplo por gerencias… ir generándolas una por una e incluso poder editar alguna y actualizarla sin generar toda la tabla nuevamente.

  21. Hola Lucía:

    Aunque te Excel indique que deja de responder, en realidad sigue trabajando y funcionando. Debes esperar a que se ejecute el código, puede tardar bastante tiempo pero lo realizará. 150 Registros los debería resolver.

    Saludos.

  22. Muchas gracias por la respuesta. Ahí lo comprobe y funciona pero tarda 20 minutos. Es demasiado. Igualmente me sería últil pensarlo en módulos para incluso ante modficaciones en un solo sector no actualizar el organigrama completo. Esto se podría hacer?

    1. Lo que podrías hacer es, por ejemplo si hay 7 gerencias. utiliza 7 hojas con el nombre de cada gerencia y luego el código tendrías que copiarlo en 7 módulos. En cada hoja la jerarquía de cada gerencia, luego ejecutas cada macro que hace referencia a cada gerencia y que cree organigrama en otra hoja.

      Es mucho más sencillo que hacerlo de otra forma (y más rápido).

      Saludos.

        1. Hola Lucía: Serían varios SmartArt, cada uno con su código.

          Hacerlo para un único organigrama y modificar solamente la parte que varía, implica que de alguna forma la programación debería recorrer toda la estructura y verificar los cambios. Es decir, que tardaría lo mismo que si lo generases, esos 20 minutos.

          Por otra parte, en una organización el cambio del organigrama no es un proceso diario, sino anual, semestral (o mensual). Quiero decir que podrías mantenerlo, a no ser que los cambios sean cada hora o día.

          Saludos

  23. Gracias por compartir tus conocimientos,
    una pregunta, cómo puedo agrandar la caja 2,
    por ejemplo si tuviera, nombre completo o concatenado con otro campo en la misma caja
    Gracias

    1. Hola Ricardo: Lo que te aconsejo es que no toques el tamaño de las cajas, sino el tamaño de la fuente de texto.

      .TextEffect.FontSize = tamaño que indiques

  24. Buenos días!
    Como podría hacer si necesito que todos los puestos de una misma naturaleza estén a un mismo nivel. Por ejemplo, tengo un Organigrama con un Jefe de Sector, una serie de referentes y auxiliares. Los auxiliares se desprenden de los referentes pero hay un puesto de auxiliar que sale directo del Jefe de sector por lo que en el gráfico se alinea con los demás referentes. Necesito que salga directo pero se encuentre un escalón más abajo. Que puedo hacer? Me sirve el Gráfico de Jerarquía Etiquetada? Como lo utilizo?
    Gracias!

  25. woooooooooooooooooooooow… me encanta

    tengo algo «parecido» pero con shapes y conectores buscando origen y destino… pero claro, los tengo que colocar en la hoja por coordenadas y eso es complicado… de esta forma el propio excel lo hace de forma «nativa»

    Muy bueno

Responder a DannyR Cancelar respuesta

Este sitio web utiliza cookies para que usted tenga la mejor experiencia de usuario. Si continúa navegando está dando su consentimiento para la aceptación de las mencionadas cookies y la aceptación de nuestra política de cookies, pinche el enlace para mayor información.plugin cookies

ACEPTAR
Aviso de cookies