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 |
Partager