From the Microsoft website:
With dozens of ready-to-use templates and thousands of customizable shapes, Visio makes it easy —and fun— to create powerful visuals.
So with Visio we can draw charts, plans and diagrams.
Some people have used Visio to create their Logical and/or Physical Data Models and they would like to import their drawings in a data architecture and design tool: ER/Studio Data Architect.
The issue with Visio Drawings is that you can draw your Entities, Attributes, Relationships, by using different shapes as there’s a vast library of shapes, stencils, and templates.
Moreover, even if everyone is using the same objects, you can connect your relationships in many different ways: between 2 attributes, between 2 entities, in fact, between any 2 Connection Points. So, it would be really difficult to create a generic macro which works for everybody.
However, in this blog post, I’ll share 2 scripts which can import Entities & Attributes from a Visio Drawing page. I have tested the macros with 2 different samples:
To run the macros below, you’d need:
The 2 scripts are using a Reference to the Visio Library Type. You need to add this Reference to your macro.
To do so, from the Macro Editor, right-click in the Code Window and select the menu item: Edit/References…
The References dialog shows the current macro/module/project’s references. You need to add the Visio Type Library:
Once, it’s done, you can copy/paste the code below in your Macro Editor:
'#Language "WWB-COM"
''MACRO TITLE: Import Entities & Attributes from Visio
' MACRO VERSION: 1.0
'
'This macro imports Entities and Attributes from a Visio Drawing
'
' Requirements:
' Visio needs to be installed on the same machine
' Macro needs to reference: Microsoft Visio 16.0 Type Library
' (right-click: Edit / References... ; check the reference above)
'
' Known limitations:
' It doesn't import the relationships
'---------------------------------------------------------------------
Option Explicit
Const VISIO_DRAWING_FILE$ = "<YOUR_PATH><FILENAME>\LDM.vsdx" ' Path to your Visio Drawing
Const TITLE$ = "Import Entities & Attributes from Visio"
Const RATIO_POSITION& = 25 ' Ratio between position in Visio Page & ER/Studio Diagram
' Depending on the shapes you are using, you may have to edit these constants
Const SHAPE_CATEGORIES = "User.msvShapeCategories"
Const CATEGORY_ENTITY$ = "DbEntity"
Const CATEGORY_ATTRIBUTE$ = "DbAttribute"
Const PRIMARY_KEY$ = "PrimaryKey"
Const FOREIGN_KEY$ = "ForeignKey"
Const NULL_OPTION$ = "Required"
Sub Main
' Visio
Dim vsoApplication As Visio.Application
Dim vsoDocument As Visio.Document
Dim vsoPage As Visio.Page
Dim vsoShape As Visio.Shape
Dim vsoAShape As Visio.Shape
Dim lMemberID&, alShapeIDs&(), lLoop&
Dim lLocationX&, lLocationY&
Dim sDateSaved$
Dim lContainerID&, lNbImportedEntities&
' ER/Studio
Dim MyDiagram As Diagram
Dim MyModel As Model
Dim MySubModel As SubModel
Dim MyEntity As Entity
Dim MyAttribute As AttributeObj
Debug.Clear
lNbImportedEntities = 0
' Open Visio
Set vsoApplication = CreateObject("Visio.Application")
' Open the Visio Drawing
Set vsoDocument = vsoApplication.Documents.OpenEx VISIO_DRAWING_FILE, visOpenRO
' Get the first page
Set vsoPage = vsoApplication.ActiveDocument.Pages(1)
' Create a new diagram.
Set MyDiagram = DiagramManager.NewDiagram
' A new diagram will automatically have a logical model - which is also the currently, active model.
Set MyModel = MyDiagram.ActiveModel
' Get the Main Model
Set MySubModel = MyModel.ActiveSubModel
MySubModel.ShowEntityNullOption = True
' Document properties
Debug.Print vsoDocument.FullName
MyDiagram.Description = "Entities & Attributes imported from " & vsoDocument.FullName
MyDiagram.ProjectName = vsoDocument.Title
MyDiagram.Author = vsoDocument.Creator
MyDiagram.Company = vsoDocument.Company
MyDiagram.CopyrightYear = Format(vsoDocument.TimeSaved, "yyyy")
' Loop on all Containers: Entities should be containers
For Each lContainerID In vsoPage.GetContainers(visContainerExcludeNested)
Set vsoShape = vsoPage.Shapes.ItemFromID(lContainerID)
If HasCategory(vsoShape, CATEGORY_ENTITY) Then
Debug.Print ""
'Get location Shape
GetShapePosition(vsoShape, lLocationX, lLocationY)
Debug.Print "Entity: " & vsoShape.Text & " [" & vsoShape.Name & " - " & vsoShape.Cells(SHAPE_CATEGORIES).Formula() & "]" & " (" & lLocationX & ", " & lLocationY & ")"
' Add the entity to the model.
Set MyEntity = MyModel.Entities.Add(lLocationX * RATIO_POSITION, - lLocationY * RATIO_POSITION)
MyEntity.EntityName = vsoShape.Text
lNbImportedEntities = lNbImportedEntities + 1
For Each lMemberID In vsoShape.ContainerProperties.GetMemberShapes(visContainerFlagsExcludeCallouts + visContainerFlagsExcludeContainers + visContainerFlagsExcludeConnectors + visContainerFlagsExcludeNested)
Set vsoAShape = vsoPage.Shapes.ItemFromID(lMemberID)
If HasCategory(vsoAShape, CATEGORY_ATTRIBUTE) Then
Debug.Print "Attribute: " & vsoAShape.Text & " [" & vsoAShape.Name & " - " & vsoAShape.Cells(SHAPE_CATEGORIES).Formula() & "]"
' Add the attribute to the current entity
Debug.Print "is PK: " & GetUserDefinedCellValue(vsoAShape, PRIMARY_KEY)
Set MyAttribute = MyEntity.Attributes.Add(vsoAShape.Text, CBool(GetUserDefinedCellValue(vsoAShape, PRIMARY_KEY)))
Debug.Print "is FK: " & GetUserDefinedCellValue(vsoAShape, FOREIGN_KEY)
Debug.Print "is Not Null: " & GetUserDefinedCellValue(vsoAShape, NULL_OPTION)
If CBool(GetUserDefinedCellValue(vsoAShape, NULL_OPTION)) Then
MyAttribute.NullOption = "NOT NULL"
Else
MyAttribute.NullOption = "NULL"
End If
End If
Next
' Log the related objects to the current Entity
alShapeIDs = vsoShape.ConnectedShapes(visConnectedShapesAllNodes, "")
For lLoop = 0 To UBound(alShapeIDs)
Set vsoAShape = vsoPage.Shapes.ItemFromID(alShapeIDs(lLoop))
Debug.Print "Related objects: " & vsoAShape.Name & ": " & vsoAShape.Text
Next
Else
Debug.Print "Ignored object in main loop: " & vsoShape.Type & "(" & vsoShape.Name & "): " & vsoShape.Text
End If
Next
' Exit Visio
vsoApplication.Quit
MsgBox "Import completed." & vbCrLf & "(" & lNbImportedEntities & " entit" & IIf(lNbImportedEntities > 1, "ies", "y") & " created)", vbInformation, TITLE
End Sub
Private Sub GetShapePosition(ByVal vsoShape As Visio.Shape, ByRef lLocationX&, ByRef lLocationY&)
Dim celObj As Visio.Cell
'Get location Shape
' X
Set celObj = vsoShape.Cells("PinX")
If Not celObj Is Nothing Then
lLocationX = celObj.Result("cm")
Else
lLocationX = 0
End If
' Y
Set celObj = vsoShape.Cells("PinY")
If Not celObj Is Nothing Then
lLocationY = celObj.Result("cm")
Else
lLocationY = 0
End If
End Sub
Private Function HasCategory(vsoShape As Visio.Shape, sCategory$) As Boolean
Dim vsoCell As Visio.Cell
If vsoShape.CellExists(SHAPE_CATEGORIES, False) Then
Set vsoCell = vsoShape.Cells(SHAPE_CATEGORIES)
HasCategory = InStr(";" & Mid(vsoCell.Formula, 2, Len(vsoCell.Formula) - 2) & ";", ";" & sCategory & ";") > 0
Else
HasCategory = False
End If
End Function
Private Function GetUserDefinedCellValue(vsoShape As Visio.Shape, sKey$) As String
Dim vsoCell As Visio.Cell
If vsoShape.CellExists("User." & sKey, False) Then
Set vsoCell = vsoShape.Cells("User." & sKey)
GetUserDefinedCellValue = vsoCell.Formula
Else
GetUserDefinedCellValue = ""
End If
End FunctionIf you don’t know how to proceed, this short video shows how to create a macro from a script in ER/Studio Data Architect:
A second script which adds a User Dialog shown when the macro runs:
'#Language "WWB-COM"
''MACRO TITLE: Import Entities & Attributes from Visio
' MACRO VERSION: 1.0
'
'This macro imports Entities and Attributes from a Visio Drawing
'
' Requirements:
' Visio needs to be installed on the same machine
' Macro needs to reference: Microsoft Visio 16.0 Type Library
' (right-click: Edit / References... ; check the reference above)
'
' Known limitations:
' It doesn't import the relationships
'---------------------------------------------------------------------
Option Explicit
Const TITLE$ = "Import Entities & Attributes from Visio"
Const DEFAULT_RATIO_POSITION& = 25 ' Ratio between position in Visio Page & ER/Studio Diagram
Const DEFAULT_VISIO_DRAWING_FILE$ = "<YOUR_PATH><FILENAME>\LDM.vsdx" ' Path to your Visio Drawing
' Depending on the shapes you are using, you may have to edit these constants
Const DEFAULT_SHAPE_CATEGORIES = "User.msvShapeCategories"
Const DEFAULT_CATEGORY_ENTITY$ = "DbEntity"
Const DEFAULT_CATEGORY_ATTRIBUTE$ = "DbAttribute"
Const DEFAULT_PRIMARY_KEY$ = "PrimaryKey"
Const DEFAULT_FOREIGN_KEY$ = "ForeignKey"
Const DEFAULT_NULL_OPTION$ = "Required"
Sub Main
' Visio
Dim vsoApplication As Visio.Application
Dim vsoDocument As Visio.Document
Dim vsoPage As Visio.Page
Dim vsoShape As Visio.Shape
Dim vsoAShape As Visio.Shape
Dim lMemberID&, alShapeIDs&(), lLoop&
Dim lLocationX&, lLocationY&
Dim sDateSaved$, sPath$
Dim lContainerID&, lNbImportedEntities&
' Settings
Dim iRatio%
Dim sShapeCategories$
Dim sDbEntity$
Dim sDbAttribute$
Dim sPrimaryKey$
Dim sForeignKey$
Dim sNullOption$
' ER/Studio
Dim MyDiagram As Diagram
Dim MyModel As Model
Dim MySubModel As SubModel
Dim MyEntity As Entity
Dim MyAttribute As AttributeObj
Dim bNewProject As Boolean
Debug.Clear
lNbImportedEntities = 0
Begin Dialog UserDialog 530,336,TITLE,.DialogFunc ' %GRID:10,7,1,1
GroupBox 10,7,510,42,"Visio Drawing",.gbPath
Text 20,21,50,14,"Path: ",.Text1,1
TextBox 80,20,360,21,.Path
PushButton 450,21,60,21,"Browse",.Browse
GroupBox 10,56,280,49,"Import into",.gbImport
OptionGroup .ogModel
OptionButton 30,77,120,14,"New model",.obNew
OptionButton 160,77,120,14,"Current model",.obCurrent
GroupBox 300,56,220,49,"Entities positions",.gbRatio
Text 310,77,60,14,"Ratio:",.tRatio,1
TextBox 380,76,130,21,.tbRatio
GroupBox 10,112,510,189,"Settings",.gbSettings
Text 20,133,130,14,"Categories cell:",.tCell,1
TextBox 160,132,350,21,.tbCell
Text 20,161,130,14,"Entity category:",.tEntity,1
TextBox 160,160,350,21,.tbEntity
Text 20,189,130,14,"Attribute category:",.tAttribute,1
TextBox 160,188,350,21,.tbAttribute
Text 20,217,130,14,"Primary Key cell:",.tPK,1
TextBox 160,216,350,21,.tbPK
Text 20,245,130,14,"Foreign Key cell:",.tFK,1
TextBox 160,244,350,21,.tbFK
Text 20,273,130,14,"Null option cell:",.tNullOption,1
TextBox 160,272,350,21,.tbNullOption
OKButton 20,308,110,21
CancelButton 400,308,110,21
End Dialog
Dim dlg As UserDialog
start_dialog:
dlg.Path = DEFAULT_VISIO_DRAWING_FILE
dlg.tbRatio = "" & DEFAULT_RATIO_POSITION
dlg.tbCell = DEFAULT_SHAPE_CATEGORIES
dlg.tbEntity = DEFAULT_CATEGORY_ENTITY
dlg.tbAttribute = DEFAULT_CATEGORY_ATTRIBUTE
dlg.tbPK = DEFAULT_PRIMARY_KEY
dlg.tbFK = DEFAULT_FOREIGN_KEY
dlg.tbNullOption = DEFAULT_NULL_OPTION
'start dialog
If Dialog(dlg) = -1 Then
' Open Visio
Set vsoApplication = CreateObject("Visio.Application")
'this Error Is For an errant file path, Dialog will be restarted
On Error GoTo Error_open
sPath = dlg.Path
iRatio = Val(dlg.tbRatio)
bNewProject = dlg.ogModel = 0
sShapeCategories= dlg.tbCell
sDbEntity= dlg.tbEntity
sDbAttribute= dlg.tbAttribute
sPrimaryKey= dlg.tbPK
sForeignKey= dlg.tbFK
sNullOption= dlg.tbNullOption
' Open the Visio Drawing
Set vsoDocument = vsoApplication.Documents.OpenEx sPath, visOpenRO
On Error GoTo Error_unknown
DiagramManager.EnableScreenUpdateEx(False, False)
' Get the first page
Set vsoPage = vsoApplication.ActiveDocument.Pages(1)
If bNewProject Then
' Create a new diagram.
Set MyDiagram = DiagramManager.NewDiagram
Else
' Get current diagram.
Set MyDiagram = DiagramManager.ActiveDiagram
End If
' A new diagram will automatically have a logical model - which is also the currently, active model.
Set MyModel = MyDiagram.ActiveModel
' Get the Main Model
Set MySubModel = MyModel.ActiveSubModel
MySubModel.ShowEntityNullOption = True
' Document properties
Debug.Print vsoDocument.FullName
MyDiagram.Description = "Entities & Attributes imported from " & vsoDocument.FullName
MyDiagram.ProjectName = vsoDocument.Title
MyDiagram.Author = vsoDocument.Creator
MyDiagram.Company = vsoDocument.Company
MyDiagram.CopyrightYear = Format(vsoDocument.TimeSaved, "yyyy")
' Loop on all Containers: Entities should be containers
For Each lContainerID In vsoPage.GetContainers(visContainerExcludeNested)
Set vsoShape = vsoPage.Shapes.ItemFromID(lContainerID)
If HasCategory(vsoShape, sShapeCategories, sDbEntity) Then
Debug.Print ""
'Get location Shape
GetShapePosition(vsoShape, lLocationX, lLocationY)
Debug.Print "Entity: " & vsoShape.Text & " [" & vsoShape.Name & " - " & vsoShape.Cells(sShapeCategories).Formula() & "]" & " (" & lLocationX & ", " & lLocationY & ")"
' Add the entity to the model.
Set MyEntity = MyModel.Entities.Add(lLocationX * iRatio, - lLocationY * iRatio)
MyEntity.EntityName = vsoShape.Text
lNbImportedEntities = lNbImportedEntities + 1
For Each lMemberID In vsoShape.ContainerProperties.GetMemberShapes(visContainerFlagsExcludeCallouts + visContainerFlagsExcludeContainers + visContainerFlagsExcludeConnectors + visContainerFlagsExcludeNested)
Set vsoAShape = vsoPage.Shapes.ItemFromID(lMemberID)
If HasCategory(vsoAShape, sShapeCategories, sDbAttribute) Then
Debug.Print "Attribute: " & vsoAShape.Text & " [" & vsoAShape.Name & " - " & vsoAShape.Cells(sShapeCategories).Formula() & "]"
' Add the attribute to the current entity
Debug.Print "is PK: " & GetUserDefinedCellValue(vsoAShape, sPrimaryKey)
Set MyAttribute = MyEntity.Attributes.Add(vsoAShape.Text, CBool(GetUserDefinedCellValue(vsoAShape, sPrimaryKey)))
Debug.Print "is FK: " & GetUserDefinedCellValue(vsoAShape, sForeignKey)
Debug.Print "is Not Null: " & GetUserDefinedCellValue(vsoAShape, sNullOption)
If CBool(GetUserDefinedCellValue(vsoAShape, sNullOption)) Then
MyAttribute.NullOption = "NOT NULL"
Else
MyAttribute.NullOption = "NULL"
End If
End If
Next
' Log the related objects to the current Entity
alShapeIDs = vsoShape.ConnectedShapes(visConnectedShapesAllNodes, "")
For lLoop = 0 To UBound(alShapeIDs)
Set vsoAShape = vsoPage.Shapes.ItemFromID(alShapeIDs(lLoop))
Debug.Print "Related objects: " & vsoAShape.Name & ": " & vsoAShape.Text
Next
Else
Debug.Print "Ignored object in main loop: " & vsoShape.Type & "(" & vsoShape.Name & "): " & vsoShape.Text
End If
Next
' Exit Visio
vsoApplication.Quit
MsgBox "Import completed." & vbCrLf & "(" & lNbImportedEntities & " entit" & IIf(lNbImportedEntities > 1, "ies", "y") & " created)", vbInformation, TITLE
DiagramManager.EnableScreenUpdateEx(True, True)
Exit Sub
Error_open:
MsgBox("Please enter a valid path.", vbExclamation, TITLE)
GoTo start_dialog
Error_unknown:
MsgBox(Err.Description, vbExclamation, TITLE)
If Not vsoApplication Is Nothing Then
vsoApplication.Quit()
End If
End If
DiagramManager.EnableScreenUpdateEx(True, True)
End Sub
Private Sub GetShapePosition(ByVal vsoShape As Visio.Shape, ByRef lLocationX&, ByRef lLocationY&)
Dim celObj As Visio.Cell
'Get location Shape
' X
Set celObj = vsoShape.Cells("PinX")
If Not celObj Is Nothing Then
lLocationX = celObj.Result("cm")
Else
lLocationX = 0
End If
' Y
Set celObj = vsoShape.Cells("PinY")
If Not celObj Is Nothing Then
lLocationY = celObj.Result("cm")
Else
lLocationY = 0
End If
End Sub
Private Function DialogFunc(DlgItem$, Action%, SuppValue&) As Boolean
Select Case Action%
Case 1 ' Dialog box initialization
DlgEnable("obCurrent", (Not DiagramManager.ActiveDiagram Is Nothing))
Case 2 ' Value changing or button pressed
If DlgItem = "Browse" Then
' Browse to Excel file if the user pushes browse button. Put path in text box.
DlgText "path", GetFilePath(,"All Visio Files (*.vsdx;*.vsd;*.vsdm)|*.vsdx;*.vsd;*.vsdm|Visio Drawing (*.vsdx)|*.vsdx|Visio Macro-enabled Drawing (*.vsdm)|*.vsdm|Visio 2003-2010 Drawing (*.vsd)|*.vsd|All Files (*.*)|*.*",,"Open SpreadSheet", 0)
DialogFunc = True
ElseIf DlgItem = "OK" And DlgText("path") = "" Then
'don't exit dialog if a path is not specified
MsgBox("Please enter a valid path.", vbExclamation, TITLE)
DialogFunc = True
End If
Case 3 ' TextBox or ComboBox text changed
If DlgItem = "tbRatio" Then
' Check if the value is a number
Dim iValue%
iValue = Val(DlgText "tbRatio")
If (iValue = 0) And (DlgText("tbRatio") <> "0") Then
MsgBox("Please enter a valid number.", vbExclamation, TITLE)
End If
DialogFunc = True
End If
Case 4 ' Focus changed
Case 5 ' Idle
Rem DialogFunc = True ' Continue getting idle actions
Case 6 ' Function key
End Select
End Function
Private Function HasCategory(vsoShape As Visio.Shape, sShapeCategories$, sCategory$) As Boolean
Dim vsoCell As Visio.Cell
If vsoShape.CellExists(sShapeCategories, False) Then
Set vsoCell = vsoShape.Cells(sShapeCategories)
HasCategory = InStr(";" & Mid(vsoCell.Formula, 2, Len(vsoCell.Formula) - 2) & ";", ";" & sCategory & ";") > 0
Else
HasCategory = False
End If
End Function
Private Function GetUserDefinedCellValue(vsoShape As Visio.Shape, sKey$) As String
Dim vsoCell As Visio.Cell
If vsoShape.CellExists("User." & sKey, False) Then
Set vsoCell = vsoShape.Cells("User." & sKey)
GetUserDefinedCellValue = vsoCell.Formula
Else
GetUserDefinedCellValue = ""
End If
End Function
From the 2 samples, I have successfully generated 2 data models which include their entities and attributes:
In this post, we have provided 2 scripts which can be used to start writing your own macro to interact with Microsoft Visio.
