[SOLVED]Excel to Visio - Drop containers according to data

[lecrick]

Hello guys!
I'm new on this forum and VBA and need your help!

I use office 2016 and i have to write a macro within Excel to create a Visio Server diagram.
My Excel is used as database and represents servers with their names, application, IP, type and environment.
The final product should be as follow :
One page per application and on each page there will be containers for environment and in those containers there will be my servers.

So far i managed to create my pages but i have difficulties to create containers.
I have to do something like : for each row in my Excel, drop a container with the name of the environment on the page which match the application's name. I have 3 environment possible but many servers on each. So i don't want to create a container if there's already one
on the page with the same name.

I guess i have to loop through shapes on my active page to get shapes names and do a If to whether drop or not a container, right? I tried many things but nothing works, i'm out of idea and need help to continue 

My code so far :

Code Select Expand

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 No_Page As Integer
Dim Sel_Page As Visio.Page
Dim Nom_Existe As Integer
Dim Container As Visio.Shape
Dim Container_Prod As Visio.Shape
Dim Container_PreP As Visio.Shape
Dim Container_Test As Visio.Shape
Dim Cont_Shape As Visio.Shape

'Lance l'application Visio
Set AppVisio = CreateObject("visio.application")
AppVisio.Visible = True

'Crée une page vide
AppVisio.Documents.AddEx (""), visMSDefault

'Dimension des pages
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"

'Ouvre le gabarit perso crée préalablement contenant les formes pour les serveurs, les serveurs de base de donnée et l'utilisateur référant
AppVisio.Documents.OpenEx "Carto.vssx", 2 + 4

'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
    End If
Next No_ligne

Hope someone can help me!
Thx.

P.S: sorry for my english, i'm a french dude 

[Surrogate]

Hi, lecrick !

Can you share there your excel example ?

PS don't worry about your bad English ! My English is worse, because I am terrible Russian

[lecrick]

Hi!

Here's an example of my Excel (+500 servers/rows)

IP Adress	Name	Application	Environment
172.20.6.58	HDD01-100	Sharepoint	Production
172.20.6.128	HDD01-065	GoodMeeting	Test

It's subject to change but that's the general idea.
multiple servers can have the same application and same environment or same application but not in the same environment

[Surrogate]

1. You want drop masters with names which contain in column Name from stencil named Carto.vssx ?
2. you want just drop these masters, without define position on page via code?
3. you don't need connect these servers with any arrows  via code?

Really just drop, rename pages and add to servers shape some shape data ?

[lecrick]

I need to sort servers per applications and environments.
Applications will be Visio pages and environments will be containers.

For example i have a server "HDD01-100" as name, have "Sharepoint" as application and it's in the "Production" environment.
So this server will be on a Visio page named "Sharepoint" in a container called "Production". But if i have multiple servers running Sharepoint in different environments, they'll be all on the same page but not the same container.

Example :


For the pages it's already done (look at my code) but now i have to do something similar but with containers. I could simply drop 3 containers on each page but some applications aren't present in the 3 environments: let's say i have 4 servers running citrix in production environment and 4 as well in pre-production environment but none in test, so i only need 2 container.
Also they must fill the page so if there's one or three i'll have to define position and size of the containers with code.

And after i'll drop shapes servers in those containers with Excel data in the graphical data.

Carto.vssx is just my stencil for my servers shapes.

[lecrick]

I found the way!!

Code Select Expand

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)
   
    Dim a As Boolean
    a = False
    For Each Cont_Shape In AppVisio.ActivePage.Shapes
       
        If Cont_Shape.Text = Environ Then
            a = True
            Exit For
        End If
    Next Cont_Shape
           
    If a = True Then
       
    Else
        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
    End If
   
Next No_ligne

It works fine but i have more questions:
Is it possible to automatically resize and positioning my containers for them to fill the page?
Like if I only have 1 or 2 containers then they expand to fit all the page?
Cause right now all the containers created are dropped in the middle of the page inside an another container if there's already one.

Thx for the help