Create Visio document from Excel using VBA

B

bydganwil

New Member
Joined
Jul 20, 2012
Messages
27
Hi there,

I have a spreadsheet with 20 rows of data with just 1 column. I need to create a visio document for each row and display the data within it. I am not concerned about how the data is displayed within Visio.

I hope somebody can help.

Rob
 
Sort by date Sort by votes
Re: Create Visio 2010 document from Excel 2013 using VBA

I greatly appreciate your participation / solutions Phil (pbornemeier). I'm in quite a pickle and come to you hat in hand since I don't have the luxury of time although rest assured that I will endeavor to understand whatever solution you are willing to provide and hopefully mentor others in the spirit you kindly express.

I need to create from the following Excel Worksheet one Visio Document of evenly distributed (both vertically and horizontally, more or less) "shapes" for "Computers" and "Switches". No Drawing size limitation since "panning" within the Visio environment is all that is required (No hardcopy requirement).

Excel Worksheet Columns as follows:

[A1:Device Number][B1:Description 1][C1:Description 2][D1:Description 3][E1:Description 4][F1:Description 5][G1:Description 6][H1:Description 7]

Column data (number of Devices) of varying vertical Cell count but equal across all Columns.

- Each Shape will be either "PC" from the "Computers and Monitors - 3D" Stencil or "Switch" from the "Network and Peripherals - 3D" Stencil as indicated in [G1:Description 6]

- Horizontal Text box at the top of the Visio Drawing with text from Cell I1.

- Visio Data->"Shape Data Window" (Data for each Shape from corresponding Excel Row, one row per Shape with Cell Range A1:H1, please see Worksheet description above.)

- Legend with Title with text from Excel Cell I2, Subtitle with text from Excel Cell I3 with Symbol(Shape)/Count/Description Columns.

- Is it possible to draw boxes around Shape groups with their own Legend (one Legend per Shape group) ?? ... or somehow indicate groups of Shapes each group with it's own legend ??

- I seem to have to do the "References to Application" ticks everytime I re-execute the Macros above. Is there anyway to set these programmatically ?? :
'If the error "User-defined type not defined' is displayed you must add a
'Reference to the Visio Application to the VBA Environment as follows:
'1) From the Microsoft Visual Basic window menu: Tools | References
'2) Scroll to and select 'Microsoft Visio x.x Type Reference Library
'3) Click OK.

Your help is greatly appreciated sir and is no doubt invaluable to countless lurkers.

I trust this note finds you well ...
 
Last edited:
Upvote 0

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
Re: Create Visio 2010 document from Excel 2013 using VBA

This should get you started.

Code: 
Option Explicit

Dim AppVisio As Object

Sub CreateVisioSheetFromExcelData()

    Dim oCharacters As Object
    Dim lRowIndex As Long
    Dim sChar As String
    Dim sMaster As String
    Dim sngXPos As Single
    Dim sngYPos As Single
    Dim lShapeCount As Long
    Dim lXOffset As Long
    Dim varItem As Variant
    Dim lShapeIndex As Long
    
    'calculate x & y positions to place shapes on a grid with 1.25 inch spacing, 6 across
    
    Set AppVisio = CreateObject("visio.application")
    AppVisio.Visible = True
    
    AppVisio.Documents.AddEx "basicd_u.vst", 0, 0   ',0,=visMSDefault

    'Open Stencils
    AppVisio.Documents.OpenEx "comps_u.vss", 2 + 4  'visOpenRO + visOpenDocked
    AppVisio.Documents.OpenEx "periph_u.vss", 2 + 4 'visOpenRO + visOpenDocked
    AppVisio.Documents.OpenEx "basic_u.vss", 2 + 4  'visOpenRO + visOpenDocked
    
    
    For lRowIndex = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    
        lShapeCount = lShapeCount + 1
        lXOffset = lXOffset + 1
        If lXOffset = 7 Then lXOffset = 1
        
        sngYPos = 0.75 + 1.25 * (Int((lShapeCount - 0.1) / 6))
        sngXPos = 0.75 + 1.25 * (lXOffset - 1)
        
        varItem = Range(Cells(lRowIndex, 1), Cells(lRowIndex, 10))
        varItem(1, 9) = sngXPos
        varItem(1, 10) = sngYPos
        'varItem (1,1)Device Number  (1,2...1,8)Description 1...7  (1,9)Xpos  (1,10)YPos

        Select Case varItem(1, 7)
        Case "PC"
            AppVisio.ActiveWindow.Page.Drop AppVisio.Documents.Item _
                ("COMPS_U.VSS").Masters.ItemU("PC"), varItem(1, 9), varItem(1, 10)
        Case "Switch"
            AppVisio.ActiveWindow.Page.Drop AppVisio.Documents.Item _
                ("PERIPH_U.VSS").Masters.ItemU("Switch"), varItem(1, 9), varItem(1, 10)
        Case Else
            Debug.Print "Not PC or Switch: " & varItem(1, 1), varItem(1, 7)
        End Select
        
        'Get ID of last shape dropped
        lShapeIndex = AppVisio.ActiveWindow.Page.Shapes.Count
        'Open Shape Sheet
        AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lShapeIndex).OpenSheetWindow
        
        'Add User Properties
        UserRow_Add "Device_Number", CStr(varItem(1, 1))
        UserRow_Add "Description_1", CStr(varItem(1, 2))
        UserRow_Add "Description_2", CStr(varItem(1, 3))
        UserRow_Add "Description_3", CStr(varItem(1, 4))
        UserRow_Add "Description_4", CStr(varItem(1, 5))
        UserRow_Add "Description_5", CStr(varItem(1, 6))
        UserRow_Add "Description_6", CStr(varItem(1, 7))
        UserRow_Add "Description_7", CStr(varItem(1, 8))
    
        'Close Shape Sheet
        AppVisio.ActiveWindow.Close
        
    Next
    

    'Create Title Block
    'Add Title at specified PinX, Piny
    AppVisio.ActiveWindow.Page.Drop AppVisio.Documents.Item("BASIC_U.VSS").Masters.ItemU("Rectangle"), _
        AppVisio.ActivePage.PageSheet.Cells("pagewidth").ResultIU / 2, sngYPos + 1.25
    lShapeIndex = AppVisio.ActiveWindow.Selection.PrimaryItem.ID
    
    'Modify Title Size
    'AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lShapeIndex).CellsSRC(1, 1, 1).FormulaU = sngYPos + 1.25  'PinY
    'AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lShapeIndex).CellsSRC(1, 1, 0).FormulaU = _
        AppVisio.ActivePage.PageSheet.Cells("pagewidth").ResultIU / 2   'PinX
    AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lShapeIndex).CellsSRC(1, 1, 2).FormulaU = _
        AppVisio.ActivePage.PageSheet.Cells("pagewidth").ResultIU - 1   'FormWidth
    AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lShapeIndex).CellsSRC(1, 1, 3).FormulaU = 1    'FormHeight

    'Modify Title Characters
    Set oCharacters = AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lShapeIndex).Characters
    oCharacters.Begin = 0
    oCharacters.End = Len(oCharacters)
    sChar = Cells(lRowIndex, 1).Value
    oCharacters.text = Range("I1").Value
    AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lShapeIndex).Cells("Char.Size").Formula = "20 pt"
    'End Create Title Block    

    Set oCharacters = Nothing
    Set AppVisio = Nothing
    
End Sub


Sub AddShape(varItem As Variant)
    'varItem (0)Device Number  (1...7)Description 1...7  (8)Xpos  (9)YPos

    Dim sMaster As String

    Select Case varItem(6)
    Case "PC"
        Application.ActiveWindow.Page.Drop Application.Documents.Item _
            ("COMPS_U.VSS").Masters.ItemU("PC"), varItem(8), varItem(9)
    Case "Switch"
        Application.ActiveWindow.Page.Drop Application.Documents.Item _
            ("PERIPH_U.VSS").Masters.ItemU("Switch"), varItem(8), varItem(9)
    Case Else
        Debug.Print "Not PC or Switch: " & varItem(1), varItem(6)
    End Select
    
    'Open Shape Sheet
    Application.ActiveWindow.Page.Shapes.ItemFromID(Application.ActiveWindow.Page.Shapes.Count).OpenSheetWindow
    
    'Add User Properties
    UserRow_Add "Device_Number", CStr(varItem(0))
    UserRow_Add "Description_1", CStr(varItem(1))
    UserRow_Add "Description_2", CStr(varItem(2))
    UserRow_Add "Description_3", CStr(varItem(3))
    UserRow_Add "Description_4", CStr(varItem(4))
    UserRow_Add "Description_5", CStr(varItem(5))
    UserRow_Add "Description_6", CStr(varItem(6))
    UserRow_Add "Description_7", CStr(varItem(7))

    'Close Shape Sheet
    Application.ActiveWindow.Close
    
End Sub

Sub UserRow_Add(sName As String, sValue As String, Optional sPrompt As String)
    'User Section has 3 columns: Name, Value, Prompt
    
    Dim lRowIndex As Long
    
    UserRow_Delete sName
    
    AppVisio.ActiveWindow.Shape.AddNamedRow 242, sName, 0 '242=visSectionUser  0=visTagDefault
    lRowIndex = AppVisio.ActiveWindow.Shape.CellsRowIndex("User." & sName)
    AppVisio.ActiveWindow.Shape.Cells("User." & sName).Formula = _
         Chr(34) & sValue & Chr(34)  'Value Column"
    AppVisio.ActiveWindow.Shape.CellsSRC(242, lRowIndex, 1).FormulaU = _
        Chr(34) & sPrompt & Chr(34)   'Prompt Column  '242=visSectionUser  1=visCustPropsPrompt

End Sub

Sub UserRow_Delete(sName As String)
    
    Dim lRowIndex As Long
    
    If AppVisio.ActiveWindow.Shape.CellExists("User." & sName, True) Then
        lRowIndex = AppVisio.ActiveWindow.Shape.CellsRowIndex("User." & sName)
        AppVisio.ActiveWindow.Shape.DeleteRow 242, lRowIndex  '242=visSectionUser
    End If
    
End Sub


- Legend with Title with text from Excel Cell I2, Subtitle with text from Excel Cell I3 with Symbol(Shape)/Count/Description Columns.
Comment: Not clear where this should go. you can copy and modify the title block code to create it

- Is it possible to draw boxes around Shape groups with their own Legend (one Legend per Shape group) ?? ... or somehow indicate groups of Shapes each group with it's own legend ??
Comment: Seems too hard. What do you mean by "shape group"

- I seem to have to do the "References to Application" ticks every time I re-execute the Macros above. Is there anyway to set these programmatically ??
Comment: This code should not require any Visio references. The references cannot be set via vba unless you check "Trust Access to the VBA project object model" in the Trust Center Macro Settings dialog. This is not a good idea.
 
Upvote 0
Re: Create Visio 2010 document from Excel 2013 using VBA

This is an awesome start indeed Phil !!

- Visio 2013 <the only version I've played with> has a "Legend" associated with each drawing that shows the number of Shapes of each kind and Stencil description for each Shape kind. The "Title and Subtitle" of the Legend are user defined. This was the Text I was referring to in Excel Cells I2 and I3. I'll look into copying and modifying the "Title Block Code" as you suggest but none of that is necessary for this version. What I need to get going for this version are the "Descriptions" in Excel Row Range AX:HX. In Visio 2013 there is a "Shape Data Window" associated with each Shape by linking external data, in this case an Excel Worksheet, to each Shape < Link Data to Shapes in the Data Tab > and this data appears in Shape Data Window activated under the Data Tab. I do see that your code is populating "User Defined Cells" associated with each Shape with the proper "Descriptions" in Excel Row Range AX:HX but after the Macro terminates, I can't find where to access this User Defined Visio Cell Data for viewing. I have little time today since I'm headed to LA but I will pour myself into understanding your code first thing tomorrow morning. I've got till Next Wednesday, June 24th, to figure this one remaining feature for this initial version.

- The Shape Groups i'm talking about will be for a Version 2 of this project. Let's say there are 10 "Shapes" in the drawing and 5 of them are in one location and the other 5 in another location. A way to show these Shapes as being in separate locations in all I meant by "Shape Group", my phrase, not Vision terminology but that is for Version 2 as I see it, like a dotted line showing the 5 Shapes together and another dotted line showing the other Shapes together and a Legend for each part of the Visio Drawing as defined by the "dotted line".

- Got it on this code not requiring any Visio References.

Your Help is INVALUALBE sir !!
 
Upvote 0
Re: Create Visio 2010 document from Excel 2013 using VBA

Having issues transferring sName and sValue from the User-defined Cells Section to the Shape Data Section for each shape.


Where sName is ::


Device_Number = Asset Number
Description_1 = Device Name
Description_2 = Manufacturer
Description_3 = Model Number
Description_4 = IP Address
Description_5 = MAC Address
Description_6 = Purpose
Description_7 << Not used at this time >>


... and sValue is from the Excel data as already implemented.


Been fiddling with ::


***
Sub UserRow_Add(sName As String, sValue As String, Optional sPrompt As String)
'User Section has 3 columns: Name, Value, Prompt

Dim lRowIndex As Long

UserRow_Delete sName

AppVisio.ActiveWindow.Shape.AddNamedRow 242, sName, 0 '242=visSectionUser 0=visTagDefault
lRowIndex = AppVisio.ActiveWindow.Shape.CellsRowIndex("User." & sName)
AppVisio.ActiveWindow.Shape.Cells("User." & sName).Formula = _
Chr(34) & sValue & Chr(34) 'Value Column"
AppVisio.ActiveWindow.Shape.CellsSRC(242, lRowIndex, 1).FormulaU = _
Chr(34) & sPrompt & Chr(34) 'Prompt Column '242=visSectionUser 1=visCustPropsPrompt


End Sub
***


Can't locate the correct Shape Data section number, Row, Column info for CellsSRC. I didn't anticipate the steep learning curve with Visio VBA giving my level of experience << none >> and time is so constricted for me that any further assistance would be greatly appreciated.
 
Last edited:
Upvote 0
Re: Create Visio 2010 document from Excel 2013 using VBA

Easier to write them directly. You will have to update row names based on what is in the Visio 13 stencils.

Code: 
Option Explicit

Dim AppVisio As Object

Sub VisioFromExcel()

    Dim oCharacters As Object
    Dim lRowIndex As Long
    Dim sChar As String
    Dim sMaster As String
    Dim sngXPos As Single
    Dim sngYPos As Single
    Dim lShapeCount As Long
    Dim lXOffset As Long
    Dim varItem As Variant
    Dim lShapeIndex As Long
    
    'calculate x & y positions to place shapes on a grid with 1.25 inch spacing, 6 across
    
    Set AppVisio = CreateObject("visio.application")
    AppVisio.Visible = True
    
    AppVisio.Documents.AddEx "basicd_u.vst", 0, 0   ',0,=visMSDefault

    'Open Stencils
    AppVisio.Documents.OpenEx "comps_u.vss", 2 + 4  'visOpenRO + visOpenDocked
    AppVisio.Documents.OpenEx "periph_u.vss", 2 + 4 'visOpenRO + visOpenDocked
    AppVisio.Documents.OpenEx "basic_u.vss", 2 + 4  'visOpenRO + visOpenDocked
    
    
    For lRowIndex = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    
        lShapeCount = lShapeCount + 1
        lXOffset = lXOffset + 1
        If lXOffset = 7 Then lXOffset = 1
        
        sngYPos = 0.75 + 1.25 * (Int((lShapeCount - 0.1) / 6))
        sngXPos = 0.75 + 1.25 * (lXOffset - 1)
        
        varItem = Range(Cells(lRowIndex, 1), Cells(lRowIndex, 10))
        varItem(1, 9) = sngXPos
        varItem(1, 10) = sngYPos
        'varItem (1,1)Device Number  (1,2...1,8)Description 1...7  (1,9)Xpos  (1,10)YPos

        Select Case varItem(1, 7)
        Case "PC"
            AppVisio.ActiveWindow.Page.Drop AppVisio.Documents.Item _
                ("COMPS_U.VSS").Masters.ItemU("PC"), varItem(1, 9), varItem(1, 10)
        Case "Switch"
            AppVisio.ActiveWindow.Page.Drop AppVisio.Documents.Item _
                ("PERIPH_U.VSS").Masters.ItemU("Switch"), varItem(1, 9), varItem(1, 10)
        Case Else
            Debug.Print "Not PC or Switch: " & varItem(1, 1), varItem(1, 7)
        End Select
        
        'Get ID of last shape dropped
        lShapeIndex = AppVisio.ActiveWindow.Selection.PrimaryItem.ID
        'Open Shape Sheet
        AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lShapeIndex).OpenSheetWindow
        
        'Add Shape Properties - Update the names to match the values in the Visio 13 Stencils
        ShapeData_Update "AssetNumber", CStr(varItem(1, 1))             'Device_Number
        ShapeData_Update "NetworkName", CStr(varItem(1, 2))             'Description_1 = Device Name
        ShapeData_Update "Manufacturer", CStr(varItem(1, 3))            'Description_2 = Manufacturer
        ShapeData_Update "ProductNumber", CStr(varItem(1, 4))           'Description_3 = Model Number (Not in Visio10 Stencil)
        ShapeData_Update "IPAddress", CStr(varItem(1, 5))               'Description_4 = IP Address
        ShapeData_Update "MACAddress", CStr(varItem(1, 6))              'Description_5 = MAC Address
        ShapeData_Update "ProductDescription", CStr(varItem(1, 7))      'Description_6 = Purpose
        'ShapeData_Update "Description_7", CStr(varItem(1, 8))          'Description_7 << Not used at this time >>

        'Add User Properties
        UserRow_Add "Device_Number", CStr(varItem(1, 1))
        UserRow_Add "Description_1", CStr(varItem(1, 2))
        UserRow_Add "Description_2", CStr(varItem(1, 3))
        UserRow_Add "Description_3", CStr(varItem(1, 4))
        UserRow_Add "Description_4", CStr(varItem(1, 5))
        UserRow_Add "Description_5", CStr(varItem(1, 6))
        UserRow_Add "Description_6", CStr(varItem(1, 7))
        UserRow_Add "Description_7", CStr(varItem(1, 8))
    
        'Close Shape Sheet
        AppVisio.ActiveWindow.Close
        
    Next
    
    'Add Title at specified PinX, Piny
    AppVisio.ActiveWindow.Page.Drop AppVisio.Documents.Item("BASIC_U.VSS").Masters.ItemU("Rectangle"), _
        AppVisio.ActivePage.PageSheet.Cells("pagewidth").ResultIU / 2, sngYPos + 1.25
    lShapeIndex = AppVisio.ActiveWindow.Selection.PrimaryItem.ID
    
    'Modify Title Size
    'AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lShapeIndex).CellsSRC(1, 1, 1).FormulaU = sngYPos + 1.25  'PinY
    'AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lShapeIndex).CellsSRC(1, 1, 0).FormulaU = _
        AppVisio.ActivePage.PageSheet.Cells("pagewidth").ResultIU / 2   'PinX
    AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lShapeIndex).CellsSRC(1, 1, 2).FormulaU = _
        AppVisio.ActivePage.PageSheet.Cells("pagewidth").ResultIU - 1   'FormWidth
    AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lShapeIndex).CellsSRC(1, 1, 3).FormulaU = 1    'FormHeight

    'Modify Title Characters
    Set oCharacters = AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lShapeIndex).Characters
    oCharacters.Begin = 0
    oCharacters.End = Len(oCharacters)
    sChar = Cells(lRowIndex, 1).Value
    oCharacters.text = Range("I1").Value
    'oCharacters.Size = 24
    AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lShapeIndex).Cells("Char.Size").Formula = "20 pt"
    
    Set oCharacters = Nothing
    Set AppVisio = Nothing
    
End Sub


Sub AddShape(varItem As Variant)
    'varItem (0)Device Number  (1...7)Description 1...7  (8)Xpos  (9)YPos

    Dim sMaster As String

    Select Case varItem(6)
    Case "PC"
        Application.ActiveWindow.Page.Drop Application.Documents.Item _
            ("COMPS_U.VSS").Masters.ItemU("PC"), varItem(8), varItem(9)
    Case "Switch"
        Application.ActiveWindow.Page.Drop Application.Documents.Item _
            ("PERIPH_U.VSS").Masters.ItemU("Switch"), varItem(8), varItem(9)
    Case Else
        Debug.Print "Not PC or Switch: " & varItem(1), varItem(6)
    End Select
    
    'Open Shape Sheet
    Application.ActiveWindow.Page.Shapes.ItemFromID(Application.ActiveWindow.Page.Shapes.Count).OpenSheetWindow
    
    'Add User Properties
    UserRow_Add "Device_Number", CStr(varItem(0))
    UserRow_Add "Description_1", CStr(varItem(1))
    UserRow_Add "Description_2", CStr(varItem(2))
    UserRow_Add "Description_3", CStr(varItem(3))
    UserRow_Add "Description_4", CStr(varItem(4))
    UserRow_Add "Description_5", CStr(varItem(5))
    UserRow_Add "Description_6", CStr(varItem(6))
    UserRow_Add "Description_7", CStr(varItem(7))

    'Close Shape Sheet
    Application.ActiveWindow.Close
    
End Sub

Sub ShapeData_Update(sName As String, sValue As String)
    'User Section has 3 columns: Name, Value, Prompt
    
    Dim lRowIndex As Long
    
    lRowIndex = AppVisio.ActiveWindow.Shape.CellsRowIndex("Prop." & sName)
    AppVisio.ActiveWindow.Shape.Cells("Prop." & sName).Formula = _
         Chr(34) & sValue & Chr(34)  'Value Column"

End Sub

Sub UserRow_Add(sName As String, sValue As String, Optional sPrompt As String)
    'User Section has 3 columns: Name, Value, Prompt
    
    Dim lRowIndex As Long
    
    UserRow_Delete sName
    
    AppVisio.ActiveWindow.Shape.AddNamedRow 242, sName, 0 '242=visSectionUser  0=visTagDefault
    lRowIndex = AppVisio.ActiveWindow.Shape.CellsRowIndex("User." & sName)
    AppVisio.ActiveWindow.Shape.Cells("User." & sName).Formula = _
         Chr(34) & sValue & Chr(34)  'Value Column"
    AppVisio.ActiveWindow.Shape.CellsSRC(242, lRowIndex, 1).FormulaU = _
        Chr(34) & sPrompt & Chr(34)   'Prompt Column  '242=visSectionUser  1=visCustPropsPrompt

End Sub

Sub UserRow_Delete(sName As String)
    
    Dim lRowIndex As Long
    
    If AppVisio.ActiveWindow.Shape.CellExists("User." & sName, True) Then
        lRowIndex = AppVisio.ActiveWindow.Shape.CellsRowIndex("User." & sName)
        AppVisio.ActiveWindow.Shape.DeleteRow 242, lRowIndex  '242=visSectionUser
    End If
    
End Sub
 
Upvote 0
Re: Create Visio 2010 document from Excel 2013 using VBA

pbornemeier said:
Easier to write them directly. You will have to update row names based on what is in the Visio 13 stencils.

Code: 
        'Get ID of last shape dropped
        lShapeIndex = AppVisio.ActiveWindow.Selection.PrimaryItem.ID
        'Open Shape Sheet
        AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lShapeIndex).OpenSheetWindow
        
        'Add Shape Properties - Update the names to match the values in the Visio 13 Stencils
Click to expand...

Works perfectly in Visio 2013 but not with 2010 which is interesting because your comment above led me to believe that you are using Visio 2010 yet when using Excel and Visio 2010, "AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lShapeIndex).OpenSheetWindow" gives me a Run-time error '91 "Object variable or With block variable not set" ... looked it up, set the Visio references that I could and no resolution ... I realize that you're not here to hold my hand but wondering if I'm just missing something obvious ...

Excel 2010 / Visio 2010 with Windows 7
Excel 2013 / Visio 2013 with Windows 8.1

Bob
 
Last edited:
Upvote 0
Re: Create Visio 2010 document from Excel 2013 using VBA

It may be that I'm using a Trial version of Visio 2010, just realized that all the features aren't available till full activation ... mmm
 
Upvote 0
Re: Create Visio 2010 document from Excel 2013 using VBA

I am using Visio Premium v 10

This seemed to be more reliable (and it does work with my version):
Code: 
        'Get ID of selection (which should be the last shape dropped, if nothing else was done since the drop)
        AppVisio.ActiveWindow.Selection.PrimaryItem.ID
For reasons I do not understand, this version would sometimes not work:
Code: 
        'Get ID of last shape dropped
        lShapeIndex = AppVisio.ActiveWindow.Page.Shapes.Count
        AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lShapeIndex).OpenSheetWindow
Even though it should (as I understand it) give the shape index of the last shape added.
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question
Issues looping through excel data range when blank rows/cells are introduced.
Replies
6
Views
530
Skyybot
Skyybot
J
  • Question
Embedding Named Excel Range in Visio VBA
Replies
0
Views
742
JJ_Excel
J
B
  • Question
Excel Membership Data to Word Document
Replies
7
Views
227
Beaglebud
B
D
  • Question
Create empty table (with headings) in Word document after some text
Replies
5
Views
132
dwsteyl
D
F
  • Question
Filtering/Copying a table via VBA.
Replies
2
Views
97
frobeniusabnorm
F

Forum statistics

Threads
1,214,544
Messages
6,120,126
Members
448,947
Latest member
test111

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top