Excel to Visio - compter formes dans conteneurs

Fermé
LeCricK Messages postés 2 Date d'inscription dimanche 22 février 2015 Statut Membre Derniè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.

Ex:
https://www.noelshack.com/2018-08-2-1519139166-sans-titre.png

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?

Merci.

Windows 8.1
Office 2016
Visio 2016
A voir également: