'
' Private Sub String tableTemplate()
'
Private Function tableTemplate(pTable As String, pDesc As String)
Dim aTableTemplate As String
aTableTemplate = "<packagedElement xmi:type=" & Chr(34) & "uml:Class" & Chr(34) & " xmi:id=" & Chr(34) & "_X00_tableid_" & pTable & Chr(34) & " name=" & Chr(34) & pTable & Chr(34) & "><ownedComment xmi:type=" & Chr(34) & "uml:Comment" & Chr(34) & " xmi:id=" & Chr(34) & "_X00_commentid_" & pTable & Chr(34) & "><body>" & pDesc & "</body></ownedComment></packagedElement>"
tableTemplate = aTableTemplate
End Function
'
' XMIExport
'
Public Sub XMIExport()
Dim L00 As String
Dim L01 As String
Dim L02 As String
Dim L03 As String
Dim L04 As String
Dim L05 As String
Dim L06_packagedElement_start As String
Dim L07_packagedElement_stop As String
Dim L0X_packagedElement_template As String
Dim L12_Model_stop As String
L00 = "<?xml version=" & Chr(34) & "1.0" & Chr(34) & " encoding=" & Chr(34) & "UTF-8" & Chr(34) & "?><uml:Model xmlns:uml=" & Chr(34) & "http://www.omg.org/spec/UML/20090901" & Chr(34) & " xmlns:xmi=" & Chr(34) & "http://schema.omg.org/spec/XMI/2.1" & Chr(34) & " xmi:version=" & Chr(34) & "2.1" & Chr(34) & " xmi:id=" & Chr(34) & "_nBUSMKAHEeW4jM4NprNllA" & Chr(34) & " name=" & Chr(34) & "du25" & Chr(34) & ">"
L01 = "<eAnnotations xmi:id=" & Chr(34) & "_nBUSMaAHEeW4jM4NprNllA" & Chr(34) & " source=" & Chr(34) & "Objing" & Chr(34) & ">"
L02 = "<contents xmi:type=" & Chr(34) & "uml:Property" & Chr(34) & " xmi:id=" & Chr(34) & "_nBUSMqAHEeW4jM4NprNllA" & Chr(34) & " name=" & Chr(34) & "exporterVersion" & Chr(34) & ">"
L03 = "<defaultValue xmi:type=" & Chr(34) & "uml:LiteralString" & Chr(34) & " xmi:id=" & Chr(34) & "_nBUSM6AHEeW4jM4NprNllA" & Chr(34) & " value=" & Chr(34) & "3.0.0" & Chr(34) & "/>"
L04 = "</contents>"
L05 = "</eAnnotations>"
L06_packagedElement_start = "<packagedElement xmi:type=" & Chr(34) & "uml:Class" & Chr(34) & " xmi:id=" & Chr(34) & "_nBUSNKAHEeW4jM4NprNllA" & Chr(34) & " name=" & Chr(34) & "a901" & Chr(34) & ">"
L06_packagedElement_stop = "</packagedElement>"
L06_packagedElement_template = "<packagedElement xmi:type=" & Chr(34) & "uml:Class" & Chr(34) & " xmi:id=" & Chr(34) & "_nBUSNKAHEeW4jM4NprNllA" & Chr(34) & " name=" & Chr(34) & "a901" & Chr(34) & "><ownedComment xmi:type=" & Chr(34) & "uml:Comment" & Chr(34) & " xmi:id=" & Chr(34) & "_nBUSNaAHEeW4jM4NprNllA" & Chr(34) & "><body>Description de la table 901</body></ownedComment></packagedElement>"
L12 = "</uml:Model>"
Dim aCounter As Integer
Dim aShapeCount As Integer
Dim theVSOShapes As Visio.Shapes
Dim aName As String
Dim aTable As String
Dim aTableDesc As String
Dim aString As String
Dim aShape As Shape
Set theVSOShapes = ActiveDocument.Pages.Item(2).Shapes
Debug.Print "-Shape Name List For..."
Debug.Print "-Document: "; ActiveDocument.Name
Debug.Print "-Page: "; ActiveDocument.Pages.Item(2).Name
aShapeCount = theVSOShapes.Count
Debug.Print L00
Debug.Print L01
Debug.Print L02
Debug.Print L03
Debug.Print L04
Debug.Print L05
If aShapeCount > 0 Then
For aCounter = 1 To aShapeCount
Set aShape = theVSOShapes.Item(aCounter)
aName = aShape.Name
' Debug.Print "aName : "; aName
If (InStr(1, aName, "x00.table.") = 1) Then
aTable = ""
If IsNumeric(Mid(aName, 11, Len(aName) - 10)) Then
' Debug.Print "Middle : "; Mid(aName, 11, Len(aName) - 10)
aTable = aShape.Shapes("x00.table.nom").Text
aTableDesc = aShape.Shapes("x00.table.description").Text
If (aTable <> "") Then
' Debug.Print "Nom : "; aTable; " "; aTableDesc
Debug.Print tableTemplate(aTable, aTableDesc)
Else
' Debug.Print "Name : "; aName
End If
End If
End If
Next aCounter
Else
Debug.Print " No Shapes On Page"
End If
Debug.Print L12
End Sub
'
' XMIExportWithAddOn
'
Sub XMIExportWithAddOn()
Dim VisioAddons As Visio.Addons
Dim VisioAddon As Visio.Addon
Set theAddons = Visio.Addons
Set anAddon = Visio.Addons("UML Background Add-on")
anAddon.Run ("/CMD=400 /XMIFILE=""D:\du25.xmi""")
End Sub