CODEWITHSUNDEEP
excelvbashapesvisio
Fallen
Fallen

Reputation: 37

looking to fill shape data from external data like excel

Sub Macro1()

    'Enable diagram services
    Dim DiagramServices As Integer
    DiagramServices = ActiveDocument.DiagramServicesEnabled
    ActiveDocument.DiagramServicesEnabled = visServiceVersion140 + visServiceVersion150

    Application.ActiveDocument.DataRecordsets.Add "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=C:\Users\Jai\Desktop\Name.xlsx;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;MaxScanRows=0;Excel 12.0;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=35;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support Complex Data=False;Jet OLEDB:Bypass UserInfo Validation=False;Jet OLEDB:Limited DB Caching=False;Jet OLEDB:Bypass ChoiceField Validation=False", "select * from `Sheet1$`", 0, "Sheet1"

    Dim vsoPrimaryKeys1(1 To 1) As String
    vsoPrimaryKeys1(1) = "Names"
    Application.ActiveDocument.DataRecordsets.ItemFromID(1).SetPrimaryKey VisPrimaryKeySettings.visKeySingle, vsoPrimaryKeys1

    Application.ActiveWindow.Windows.ItemFromID(visWinIDExternalData).Visible = True

    Dim UndoScopeID2 As Long
    UndoScopeID2 = Application.BeginUndoScope("Drop On Stencil")
    Application.Documents.Item("C:\Users\Jai\Documents\Drawing1.vsdm").Masters.Drop Application.Documents.Item("BASIC_U.vssx").Masters.ItemU("Rectangle"), 0#, 0#
    Application.EndUndoScope UndoScopeID2, True

    ActiveWindow.DeselectAll
    ActiveWindow.Select Application.ActiveWindow.Page.Shapes.ItemFromID(1), visSelect
    Application.ActiveWindow.Selection.LinkToData 1, 2, True

    ActiveWindow.DeselectAll
    ActiveWindow.Select Application.ActiveWindow.Page.Shapes.ItemFromID(2), visSelect
    Application.ActiveWindow.Selection.LinkToData 1, 3, True

    ActiveWindow.DeselectAll
    ActiveWindow.Select Application.ActiveWindow.Page.Shapes.ItemFromID(3), visSelect
    Application.ActiveWindow.Selection.LinkToData 1, 4, True

    'Restore diagram services
    ActiveDocument.DiagramServicesEnabled = DiagramServices

End Sub

Hi, I'm trying to fetch data from excel then fill to shape data field called "Names" I tried recording macro use it for different shape, then i get runtime error which indicates to ItemFromID() which keeps changing every time I add new shape, I got to know that Item ID cannot be changed, Is there any way to identify the shapeID and fill shape data and continue for the next shape until there is no shape available to fill.

Edit

'''
     Sub twodrop()
        Dim vsoReturnedSelection As Visio.Selection
        Dim sh As Shape
        Dim x As Integer, y As Integer
        x = 7
        y = 9
        Set sh = ActivePage.Drop(Application.Documents.Item("sample.vssx").Masters.ItemU("Rectangle"), x, y)
        Set rel = sh.SpatialNeighbors(visSpatialOverlap, 0.25, 0)
        If rel.Count > 0 Then
        Do
        x = x + 2
        sh.SetCenter x, y
        Set rel = sh.SpatialNeighbors(visSpatialOverlap, 0.25, 0)
        Loop While rel.Count > 0
        End If
        Set sh = ActivePage.Drop(Application.Documents.Item("sample.vssx").Masters.ItemU("Rectangle"), x, y)
        Set rel = sh.SpatialNeighbors(visSpatialOverlap, 0.25, 0)
        If rel.Count > 0 Then
        Do
        x = x + 2
        sh.SetCenter x, y
        Set rel = sh.SpatialNeighbors(visSpatialOverlap, 0.25, 0)
        Loop While rel.Count > 0
        End If
        End Sub
    
 Public Sub DropLinked_Example()
         
            Dim vsoShape As Visio.Shape
            Dim vsoMaster As Visio.Master
            Dim dblX As Double
            Dim dblY As Double
            Dim lngDataRowID As Long
            Dim vsoDataRecordset As Visio.DataRecordset
            Dim intRecordesetCount As Integer
         
            intRecordsetCount = Visio.ActiveDocument.DataRecordsets.Count
            Set vsoDataRecordset = Visio.ActiveDocument.DataRecordsets(intRecordsetCount)
             
            Set vsoMaster = Visio.Documents("sample.vssx").Masters("Rectangle")
            dblX = 2
            dblY = 2
            lngDataRowID = 1
         
            Set vsoShape = ActivePage.DropLinked(vsoMaster, dblX, dblY, vsoDataRecordset.ID, lngDataRowID, True)
         
        End Sub
'''

Upvotes: 0

Views: 213

Answers (1)

JohnGoldsmith
JohnGoldsmith

Reputation: 2698

It looks like the macro recording doesn't pick up all of the steps. The code shows the new rectangle master being added to its collection (Masters.Drop) but not the Page.Drop method where the shapes are added to the page.

Both Drop methods return the respective Master or Shape that was added and you can then reference this to get its ID. For example:

    Sub DropMasterInstance()
    
        Dim vDoc As Visio.Document
        Dim mst As Visio.Master
        Dim shp As Visio.Shape
        
        Set vDoc = ActiveDocument
        'Add the required master to the local masters collection
        'Assumes Basic Shapes stencil is already open (note metric or universal suffix)
        Set mst = vDoc.Masters.Drop(Application.Documents.Item("BASIC_M.vssx").Masters.ItemU("Rectangle"), 0#, 0#)
        
        'Now drop a shape instance
        Set shp = ActivePage.Drop(mst, 3, 3)
        Debug.Print "Dropped shape id: " & shp.ID
    
    End Sub

You can also save yourself some work by using the DropLinked method which does the data linking for you. Here's an example from the docs:

    Public Sub DropLinked_Example() 
     
        Dim vsoShape As Visio.Shape 
        Dim vsoMaster As Visio.Master 
        Dim dblX As Double 
        Dim dblY As Double  
        Dim lngDataRowID As Long 
        Dim vsoDataRecordset As Visio.DataRecordset 
        Dim intRecordesetCount As Integer 
     
        intRecordsetCount = Visio.ActiveDocument.DataRecordsets.Count 
        Set vsoDataRecordset = Visio.ActiveDocument.DataRecordsets(intRecordsetCount) 
         
        Set vsoMaster = Visio.Documents("Basic_U.VSS").Masters("Rectangle") 
        dblX = 2 
        dblY = 2 
        lngDataRowID = 1 
     
        Set vsoShape = ActivePage.DropLinked(vsoMaster, dblX, dblY, vsoDataRecordset.ID, lngDataRowID, True) 
     
    End Sub

Upvotes: 1

Related Questions