Aide pour créer automatiquement un diagramme de base de données

**marot_r** · 07/05/2015, 17h23

Bonjour à vous et merci de votre temps et de votre aide.

Je suis GRAND débutant en Visio.

J'ai une BD Access que je souhaite documenter. Les vielles versions de Visio permettaient, à partir de la BD de générer le schéma mais plus Visio 2013.
J'ai pensé créer une macro à qui je fournirai le schéma sous forme de fichier texte et qui me générerait le diagramme.
J'ai branché l'enregistreur de macro de Visio et ce qu'il ma généré a l'air assez compliqué.

Ce que je souhaite avoir :

Mes tables, et leurs champs.
Mes relations entre mes tables de champ à champ.

Idéalement les tables seraient disposées de manière optimale sinon je finirai à la main.

Je souhaite utiliser "la notification en pate d'oie". En interne cela ressemble`à Application.Documents.Item("DBCROW_M.VSSX").Masters.ItemU("Entity").

Est-ce que quelqu'un a déjà fait cela ?

Sinon, pourrait me guider pour :

Créer une forme "Table"
et lui donner un nom interne précis (ex : tblDetailCommande)
et mettre l'entête à jour.
Créer un attribut de type "Clef Primaire" dans la "table".
Lui donner un nom interne (ex : tblDetailCommande.ClefDetailCommande)
et mettre le texte correspondant à jour.
Créer un attribut de type "Attribut".
Lui donner un nom interne (ex : tblDetailCommande.ClefProduit)
et mettre le texte correspondant à jour.
Créer une relation entre 2 attributs appartenant à 2 tables distinctes.
Lui donner un nom (ex : tblDetailCommande.ClefProduit_tblProduit.ClefProduit).

L'usage de nom interne n'est pas absolument indipensable mais je pense qu'il faciliterai la conception,

A+

**marot_r** · 01/06/2015, 13h56

Bonjour à tous.

Pour ceux que cela pourrait intéresser voici ce que j'ai fait :

Classe clsInfoChamp

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Option Explicit
 
Public Position As Long
Public Nom
Public EstClefPrimaire As Boolean

Création d'une table

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Private Sub CreerTable(prmNomTable, prmTChamp As Collection, prmXCm As Double, prmYCm As Double)
    Dim listeDocuments As Visio.Documents: Set listeDocuments = Application.Documents
    Dim listeForme As Visio.Document: Set listeForme = listeDocuments.OpenEx("DBCROW_M.VSSX", visOpenDocked)
    Dim page As Visio.page: Set page = Application.ActivePage
    Dim masterTable As Visio.master: Set masterTable = listeForme.Masters.ItemU("Entity")
    Dim Table As Visio.shape: Set Table = page.Drop(masterTable, prmXCm / 2.54, prmYCm / 2.54)
    Table.Name = "[" & prmNomTable & "]"
    Table.Text = prmNomTable
 
    Dim forme As Visio.shape
 
    'Supprime les éléments déjà dans l'entité
    Dim clefForme As Variant: For Each clefForme In Table.ContainerProperties.GetMemberShapes(visContainerFlagsDefault)
        Debug.Print clefForme
        Set forme = page.Shapes.ItemFromID(clefForme)
        'Debug.Print "Suppression : " & forme.NameU
        forme.Delete
    Next clefForme
 
    Dim masterChamp As Visio.master: Set masterChamp = listeForme.Masters.ItemU("Attribute")
    Dim masterChampClefPrimaire As Visio.master: Set masterChampClefPrimaire = listeForme.Masters.ItemU("Primary Key Attribute")
    Dim champ As Visio.shape
 
    Dim infoChamp As clsInfoChamp
 
    For Each infoChamp In prmTChamp
 
        If infoChamp.EstClefPrimaire Then
                Set champ = page.DropIntoList(masterChampClefPrimaire, Table, infoChamp.Position)
            Else
                Set champ = page.DropIntoList(masterChamp, Table, infoChamp.Position)
        End If
 
        champ.Name = Table.Name & ".[" & infoChamp.Nom & "]"
        champ.Text = infoChamp.Nom
        Debug.Print champ.Name
        Set champ = Nothing
 
    Next infoChamp
 
    Set infoChamp = Nothing
    Set listeDocuments = Nothing
    Set listeForme = Nothing
    Set page = Nothing
    Set champ = Nothing
    Set Table = Nothing
End Sub

Creation d'une relation

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Private Sub CreerRelation(prmChamp1 As Visio.shape, prmChamp2 As Visio.shape)
    Dim listeDocuments As Visio.Documents: Set listeDocuments = Application.Documents
    Dim listeForme As Visio.Document: Set listeForme = listeDocuments.OpenEx("DBCROW_M.VSSX", visOpenDocked)
    Dim page As Visio.page: Set page = Application.ActivePage
 
    'Créé la relation
    Dim masterRelation As Visio.master: Set masterRelation = listeForme.Masters.ItemU("Relationship")
    Dim relation As Visio.shape: Set relation = page.Drop(masterRelation, 5, 5)
    relation.Name = prmChamp1.Name & "-" & prmChamp2.Name
 
    ' Utilise un trait droit
    relation.CellsSRC(visSectionObject, visRowShapeLayout, visSLOLineRouteExt).FormulaU = "1"
    relation.CellsSRC(visSectionObject, visRowShapeLayout, visSLORouteStyle).FormulaU = "16"
 
    Dim cellChamp As Visio.Cell
    Dim cellRelation As Visio.Cell
 
    'Relie la relation à champ1
    Set cellChamp = prmChamp1.CellsU("Connections.X2")
    Set cellRelation = relation.CellsU("BeginX")
    Call cellRelation.GlueTo(cellChamp)
 
    'Relie la relation à champ2
    Set cellChamp = prmChamp2.CellsU("Connections.X1")
    Set cellRelation = relation.CellsU("EndX")
    Call cellRelation.GlueTo(cellChamp)
 
    Set relation = Nothing
    Set masterRelation = Nothing
    Set page = Nothing
    Set listeForme = Nothing
    Set listeDocuments = Nothing
End Sub

A+

**marot_r** · 04/06/2015, 21h24

Bonjour.

Il y avait un bug dans ma fonction. Les attributs étaient créés hors de l'entité quand leur nom était trop long.

Ici la version corrigée.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
Private Function CreerTable(prmNomTable, prmTChamp As Collection, prmXCm As Double, prmYCm As Double) As Double
 
    'Enable diagram services
    Dim DiagramServices As Integer
    DiagramServices = ActiveDocument.DiagramServicesEnabled
    ActiveDocument.DiagramServicesEnabled = visServiceStructureFull 'visServiceVersion140 + visServiceVersion150
 
    Dim result As Double
 
    Dim listeDocuments As Visio.Documents: Set listeDocuments = Application.Documents
    Dim listeForme As Visio.Document: Set listeForme = listeDocuments.OpenEx("DBCROW_M.VSSX", visOpenDocked)
    Dim page As Visio.page: Set page = Application.ActivePage
    Dim masterTable As Visio.master: Set masterTable = listeForme.Masters.ItemU("Entity")
    Dim Table As Visio.Shape: Set Table = page.Drop(masterTable, prmXCm / 2.54, prmYCm / 2.54)
    Table.Name = "[" & prmNomTable & "]"
    Table.Text = prmNomTable
 
    Dim forme As Visio.Shape
 
    'Supprime les éléments déjà dans l'entité
    Dim clefForme As Variant: For Each clefForme In Table.ContainerProperties.GetMemberShapes(visContainerFlagsDefault)
        Debug.Print clefForme
        Set forme = page.Shapes.ItemFromID(clefForme)
        'Debug.Print "Suppression : " & forme.NameU
        forme.Delete
    Next clefForme
 
    Dim masterChamp As Visio.master: Set masterChamp = listeForme.Masters.ItemU("Attribute")
    Dim masterChampClefPrimaire As Visio.master: Set masterChampClefPrimaire = listeForme.Masters.ItemU("Primary Key Attribute")
    Dim champ As Visio.Shape
    Dim texte As Visio.Characters
 
    Dim infoChamp As clsInfoChamp
 
    For Each infoChamp In prmTChamp
 
        If infoChamp.EstClefPrimaire Then
                Set champ = page.DropIntoList(masterChampClefPrimaire, Table, infoChamp.Position)
            Else
                Set champ = page.DropIntoList(masterChamp, Table, infoChamp.Position)
        End If
 
        champ.Name = Table.Name & ".[" & infoChamp.Nom & "]"
        champ.Text = infoChamp.Nom
        Debug.Print champ.Name
        Set champ = Nothing
    Next infoChamp
 
    Set infoChamp = Nothing
    Set listeDocuments = Nothing
    Set listeForme = Nothing
    Set page = Nothing
    Set champ = Nothing
 
    If Table.CellsU("PinY") < 0 Then
            result = prmYCm - (Table.CellsU("Height") * 2.54)
        Else
            result = prmYCm + (Table.CellsU("Height") * 2.54)
    End If
 
    Set Table = Nothing
 
    CreerTable = result
 
    'Restore diagram services
    ActiveDocument.DiagramServicesEnabled = DiagramServices
 
End Function

**lolod** · 09/10/2015, 08h27

Bonjour Marot_r

Je suis très intéressé par ce que tu as fait.
Je cherche à faire faire quelque chose de très similaire : créer un diagramme à partir d'un fichier excel/csv
Comment tu structure l'appel de tes fonctions pour générer les différents tables et liens ? et les positionner de façon pertinentes sur le schéma le moins de croisement possible)

Aide pour créer automatiquement un diagramme de base de données

Visio

Discussions similaires

Partager

Partager