Introduction
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:
- Bugs ER Diagram
- Books ER Diagram
Visio Drawing Samples
System requirements
To run the macros below, you’d need:
- ER/Studio Data Architect
- Microsoft Visio installed on the same machine (not the Cloud remote version)
Scripts
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…
Add References
The References dialog shows the current macro/module/project’s references. You need to add the Visio Type Library:
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 Function
If 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:
User dialog
'#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
Results
From the 2 samples, I have successfully generated 2 data models which include their entities and attributes:
Bugs Sample
Books Sample
Summary
In this post, we have provided 2 scripts which can be used to start writing your own macro to interact with Microsoft Visio.