LeCricK
Messages postés2Date d'inscriptiondimanche 22 février 2015StatutMembreDernière intervention 5 mars 2018
-
Modifié le 5 mars 2018 à 22:23
Bonjour,
Je suis en train d'écrire une macro en VBA pour créer un document Visio à partir d'un fichier Excel.
Il s'agira à termes de faire un diagramme de serveurs.
Chaque ligne de mon Excel représente un serveur et dans les colonnes on trouve son nom, adresse IP, application, type et son environnement (Prod, Pre-Prod et Test).
Dans le diagramme, les serveurs seront classés par applications et par environnement. En gros : chaque applications sera une page Visio et les serveurs seront rangés dans des conteneurs image de l'environnement.
Jusqu'ici, mon code créer les pages "applications", les conteneurs "environnement" et drop mes serveurs.
Code:
Option Explicit
Sub test2()
'Déclaration des variables
Dim AppVisio As Object
Dim VisioDoc As Visio.Document
Dim Col_Page As Visio.Pages
Dim Col_Shape As Visio.Shapes
Dim Pge As Visio.Page
Dim Appli As String
Dim Environ As String
Dim No_ligne As Long
Dim No_col As Long
Dim Nom_Existe As Integer
Dim Cont_Existe As Boolean
Dim Container As Visio.Shape
Dim Cont_Shape As Visio.Shape
Dim Serv_Shape As Visio.Shape
Dim Shape_Count As Long
'Lance l'application Visio
Set AppVisio = CreateObject("visio.application")
AppVisio.Visible = True
'Crée une page vide
AppVisio.Documents.AddEx (""), visMSDefault
'Mise en page
Dim DiagramServices As Integer
DiagramServices = AppVisio.ActiveDocument.DiagramServicesEnabled
AppVisio.ActiveDocument.DiagramServicesEnabled = visServiceVersion140 + visServiceVersion150
AppVisio.ActiveWindow.Page.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageWidth).FormulaU = "420 mm"
AppVisio.ActiveWindow.Page.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageHeight).FormulaU = "297 mm"
AppVisio.ActiveWindow.Page.PageSheet.CellsSRC(visSectionObject, visRowPrintProperties, visPrintPropertiesPaperKind).FormulaForceU = "8"
AppVisio.ActiveWindow.Page.PageSheet.CellsSRC(visSectionObject, visRowPrintProperties, visPrintPropertiesPageOrientation).FormulaForceU = "2"
'Application d'un Background
Set VisioDoc = AppVisio.Documents.OpenEx(AppVisio.GetBuiltInStencilFile(visBuiltInStencilBorders, visMSMetric), visOpenHidden)
Dim UndoScopeID1 As Long
Dim UndoScopeID2 As Long
UndoScopeID1 = AppVisio.BeginUndoScope("Poser sur la page")
AppVisio.ActiveWindow.Page.Drop VisioDoc.Masters.ItemU("Classic"), 8.253656, 5.86333
AppVisio.EndUndoScope UndoScopeID1, True
VisioDoc.Close
AppVisio.ActiveDocument.DiagramServicesEnabled = DiagramServices
'Parcours les lignes Excel, crée une page Visio pour chaque nom d'appli
'sauf si une page porte déjà le même nom
'Boucle principal qui parcours le fichier Excel, récupère le nom d'appli
'et créee une nouvelle page temporaire
For No_ligne = 2 To Cells(Rows.Count, 3).End(xlUp).Row
Set Col_Page = AppVisio.ActiveDocument.Pages
'Récupère le nom de l'appli
Appli = Cells(No_ligne, 3).Value
'Crée la page temporaire
Col_Page.Add.name = "NEW"
'Parcours les noms de toutes les pages du document et si une page porte
'déjà le nom de l'appli associé au No_ligne alors Nom_Existe = 1
Nom_Existe = 0
For Each Pge In Col_Page
If Pge.name = Appli Then
Nom_Existe = 1
End If
Next Pge
'Si une page porte le nom d'appli (Nom_Existe = 1) du No_ligne alors
'supprime la page "NEW" pour eviter conflit à la prochaine boucle.
'Sinon la page "NEW" prend le nom d'appli
If Nom_Existe = 1 Then
Col_Page("NEW").Delete True
Else
Col_Page.Item("NEW").name = Appli
DiagramServices = AppVisio.ActiveDocument.DiagramServicesEnabled
AppVisio.ActiveDocument.DiagramServicesEnabled = visServiceVersion140 + visServiceVersion150
'Application du Background sur les nouvelles pages
Set VisioDoc = AppVisio.Documents.OpenEx(AppVisio.GetBuiltInStencilFile(visBuiltInStencilBorders, visMSMetric), visOpenHidden)
UndoScopeID1 = AppVisio.BeginUndoScope("Poser sur la page")
AppVisio.ActiveWindow.Page.Drop VisioDoc.Masters.ItemU("Classic"), 8.253656, 5.86333
AppVisio.EndUndoScope UndoScopeID1, True
VisioDoc.Close
'Mise en page du Background
Dim VisioCharacters As Visio.Characters
Set VisioCharacters = AppVisio.ActiveWindow.Page.Shapes.ItemU("Classic").Characters
VisioCharacters.Begin = 0
VisioCharacters.End = 21
VisioCharacters.Text = Appli
VisioCharacters.CharProps(visCharacterSize) = 24#
Set VisioCharacters = Nothing
AppVisio.ActiveDocument.DiagramServicesEnabled = DiagramServices
End If
Next No_ligne
'Parcours le fichier Excel afin de créer un conteneur "environnement" sur la page
'qui porte le même nom d'appli de la ligne activée
For No_ligne = 2 To Cells(Rows.Count, 5).End(xlUp).Row
'Récupère les noms d'applis et d'environnement
Appli = Cells(No_ligne, 3).Value
Environ = Cells(No_ligne, 5).Value
'Définit la page Visio active selon le nom d'appli
AppVisio.ActiveWindow.Page = AppVisio.ActiveDocument.Pages.Item(Appli)
Cont_Existe = False
'Parcours toutes les shapes contenues sur la page active et compare leurs noms avec les data Excel
'Si un conteneur porte le même nom alors ne rien faire
'Sinon créer le conteneur
For Each Cont_Shape In AppVisio.ActivePage.Shapes
If Cont_Shape.Text = Environ Then
Cont_Existe = True
Exit For
End If
Next Cont_Shape
If Cont_Existe = True Then
Else
'Création d'un conteneur
Set VisioDoc = AppVisio.Documents.OpenEx(AppVisio.GetBuiltInStencilFile(visBuiltInStencilContainers, visMSMetric), visOpenHidden)
Set Container = AppVisio.ActiveDocument.Pages.Item(Appli).DropContainer(VisioDoc.Masters.ItemU("Alternating"), Nothing)
Container.Text = Environ
VisioDoc.Close
'Mise en page des conteneurs en fonction de l'environnement associé
If Container.Text = "PRODUCTION" Then
Container.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX).FormulaU = "210 mm"
Container.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinY).FormulaU = "230 mm"
Container.CellsSRC(visSectionObject, visRowXFormOut, visXFormWidth).FormulaU = "380 mm"
Container.CellsSRC(visSectionObject, visRowXFormOut, visXFormHeight).FormulaU = "80 mm"
' VisioCharacters.CharProps(visCharacterStyle) = 17#
' VisioCharacters.CharProps(visCharacterSize) = 24#
ElseIf Container.Text = "PRE-PRODUCTION" Then
Container.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX).FormulaU = "210 mm"
Container.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinY).FormulaU = "135 mm"
Container.CellsSRC(visSectionObject, visRowXFormOut, visXFormWidth).FormulaU = "380 mm"
Container.CellsSRC(visSectionObject, visRowXFormOut, visXFormHeight).FormulaU = "80 mm"
' VisioCharacters.CharProps(visCharacterStyle) = 17#
' VisioCharacters.CharProps(visCharacterSize) = 24#
ElseIf Container.Text = "TEST" Then
Container.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX).FormulaU = "210 mm"
Container.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinY).FormulaU = "50 mm"
Container.CellsSRC(visSectionObject, visRowXFormOut, visXFormWidth).FormulaU = "380 mm"
Container.CellsSRC(visSectionObject, visRowXFormOut, visXFormHeight).FormulaU = "80 mm"
' VisioCharacters.CharProps(visCharacterStyle) = 17#
' VisioCharacters.CharProps(visCharacterSize) = 24#
End If
End If
Next No_ligne
For No_ligne = 2 To Cells(Rows.Count, 5).End(xlUp).Row
DiagramServices = AppVisio.ActiveDocument.DiagramServicesEnabled
AppVisio.ActiveDocument.DiagramServicesEnabled = visServiceVersion140 + visServiceVersion150
Appli = Cells(No_ligne, 3).Value
Environ = Cells(No_ligne, 5).Value
AppVisio.ActiveWindow.Page = AppVisio.ActiveDocument.Pages.Item(Appli)
Select Case Environ
Case Is = "PRODUCTION"
AppVisio.Documents.OpenEx "Carto.vssx", 2 + 4
Set Serv_Shape = AppVisio.ActiveWindow.Page.Drop(AppVisio.Documents.Item("Carto.vssx").Masters.ItemU("Serveur"), 1.5, 9.5)
Serv_Shape.Text = CStr(Cells(No_ligne, 2).Value)
Case Is = "PRE-PRODUCTION"
AppVisio.Documents.OpenEx "Carto.vssx", 2 + 4
Set Serv_Shape = AppVisio.ActiveWindow.Page.Drop(AppVisio.Documents.Item("Carto.vssx").Masters.ItemU("Serveur"), 1.5, 5.5)
Serv_Shape.Text = CStr(Cells(No_ligne, 2).Value)
Case Is = "TEST"
AppVisio.Documents.OpenEx "Carto.vssx", 2 + 4
Set Serv_Shape = AppVisio.ActiveWindow.Page.Drop(AppVisio.Documents.Item("Carto.vssx").Masters.ItemU("Serveur"), 1.5, 1.5)
Serv_Shape.Text = CStr(Cells(No_ligne, 2).Value)
End Select
AppVisio.ActiveDocument.DiagramServicesEnabled = DiagramServices
Next No_ligne
Donc ma question est comment je peux faire pour positionner mes serveurs en fonction de leur nombre dans chaque conteneurs afin qu'ils prennent toute la place possible dans ces derniers. Car actuellement mon code drop les serveurs les uns sur les autres.
Ou encore mieux, existe-t-il un moyen de le faire automatiquement?