MACROS

Dim Diseño As SmartArtLayout
Dim Borrar As Excel.Shape

Dim NumCargos As SmartArtNodes
Dim i, Fin As Double

With Sheets("Organigrama") 'Cambiar el nombre de la hoja
.Select

'Si hay un organigrama en la hoja la borramos
For Each Borrar In .Shapes
Borrar.Delete
Next

'Creamos el organigrama partiendo siempre de un tipo concreto:
/NameandTitleOrganizationalChart (Tipo de organigrama)
Set Diseño =
Application.SmartArtLayouts("urn:microsoft.com/office/officeart/2008/layout/NameandTitleO
rganizationalChart")
Set inserta = .Shapes.AddSmartArt(Diseño)
Set NumCargos = inserta.SmartArt.AllNodes

Fin = Application.CountA(Sheets(1).Range("A:A")) 'Se utiliza la función Contar para saber el
número de cargos

' Mientras el numero de cargos sea inferior a las unidades del organigrama
' Seguimos creando cargos
Do While NumCargos.Count < Fin
NumCargos.Add.Promote
Loop

'El organigrama se inicia con 5 cargos, si el # cargos es inferior se eliminaran los nodos.
For i = 1 To Fin
Do While NumCargos(i).Level < Sheets(1).Range("B" & i).Value
NumCargos(i).Demote
Loop

'Para introducir texto y formato de cada unidad/caja/elemento del organigrama
With NumCargos(i)
.TextFrame2.TextRange.Text = Sheets(1).Range("A" & i) 'Texto dentro de cada unidad es
igual a la columna A + el contador
.TextFrame2.TextRange.Font.Size = 9 'Tamaño del texto de cada unidad
End With

Next
'cambiamos el diseño del organigrama Jerarquía
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, puedes ensayar con cualquier número,

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 = 50 'Izquierda
End With

Next
End With
Dim Diseño As SmartArtLayout
Dim Borrar As Excel.Shape
Dim NumCargos As SmartArtNodes
Dim i, Fin As Double

With Sheets("Organigrama") 'Cambiar el nombre de la hoja
.Select

'Borramos el organigrama si tenemos en una hoja
For Each Borrar In .Shapes
Borrar.Delete
Next

'Creamos el organigrama partiendo siempre de un tipo concreto:
/NameandTitleOrganizationalChart (Es el tipo de organigrama general)
Set Diseño =
Set inserta = .Shapes.AddSmartArt(Diseño)
Set NumCargos = inserta.SmartArt.AllNodes

Fin = Application.CountA(Sheets(1).Range("A:A")) 'Utilizamos la funcion contar para saber el
número de cargos

'Si el numero de cargos es inferior a 5 que es el numero predeterminado del organigrama se
borraran
Do While NumCargos.Count < Fin
NumCargos.Add.Promote
Loop

For i = 1 To Fin
Do While NumCargos(i).Level < Sheets(1).Range("B" & i).Value
NumCargos(i).Demote
Loop
'Para introducir texto y formato de cada cargo en cada elemento del organigrama
With NumCargos(i)
.TextFrame2.TextRange.Text = Sheets(1).Range("A" & i) 'Texto dentro de cada unidad
.TextFrame2.TextRange.Font.Size = 9 'Tamaño del texto
.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(139, 0, 0) 'Color del texto de cada
unidad, el color es el rojo
.Shapes.Item(1).TextEffect.FontBold = msoTrue 'Negrita
.Shapes.Fill.ForeColor.RGB = vbWhite 'Color de fondo de cada unidad
.Shapes.Line.BackColor.RGB = vbBlack 'Color del borde de cada unidad
End With

'Para escribir en la segunda caja de cada cargo en el organigrama
With NumCargos(i).Shapes.Item(2)
.TextFrame2.TextRange = Sheets(1).Range("C" & i) 'Texto del Nombre.
.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 139) 'Color del texto
.TextEffect.Alignment = msoTextEffectAlignmentCentered 'Alineado (centrado)
.TextEffect.FontName = "Calibri" 'Tipo de letra
.TextEffect.FontSize = 10 'Tamaño de letra
End With

Next
For Each Shape In .Shapes
Shape.SmartArt.Layout =

'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 = 50 'Izquierda
End With

Next
End With

MACROS

Cargado por

Copyright:

Formatos disponibles

MACROS

Cargado por

Información del documento

Descripción original:

Derechos de autor

Formatos disponibles

Compartir este documento

Compartir o incrustar documentos

Opciones para compartir

¿Le pareció útil este documento?

¿Este contenido es inapropiado?

Copyright:

Formatos disponibles

MACROS

Cargado por

Copyright:

Formatos disponibles

Dim Diseño As SmartArtLayout

Dim Borrar As Excel.Shape

También podría gustarte