Dupicate a master shape as multiple smart shapes

[visio]

Have a master smart shape which will work fine and auto resize itself based on data from an excel sheet. 

There is a new diagram I want to create which will involve duplicating the master shape approx 400 times as 400 shapes are required, each of the new shapes will have a unique name.

The duplication could be done by drag and drop but that will take a long time. Is there a command that can be used to duplicate the master shape as the required copies onto the page? There is a text file available of a list of the all the required shapes.

Something like
For every entry in list Do
Dupliate Master as shape1,2,3...
Place duplicate onto page

Then Each shape cad be updated by linking to the shape data by shape name and the diagram will draw itelf.

Any ideas?

[Surrogate]

The duplication could be done by drag and drop but that will take a long time. Is there a command that can be used to duplicate the master shape as the required copies onto the page? There is a text file available of a list of the all the required shapes.
…
Then Each shape cad be updated by linking to the shape data by shape name and the diagram will draw itelf.

You mean replace some shapes in exist page(s) or create new ?

[Visisthebest]

Each time you drop a master on a page, you create a new shape (the master is stored behind the scenes in the document stencil, in principle one master for any amount of shapes you create with the same master).

Is your Master an entire spreadsheet by itself already, or is it one Excel cell and you need to create about 400 of them each connected to data via shape data? If so, that is very doable and provides a lot of possibilities and flexibility.

[Yacine]

https://learn.microsoft.com/en-us/office/vba/api/visio.page.dropmany

[visio]

The duplicated shapes would be of a master in a template. Each of the duplicates would be placed onto an existing page. So this is just to emulate the drag and drop (and rename of the master to the new shape).

Rather than do the same drag and drop a few hundred times would be nice to have this scripted then read from a file.

This was each shape is linked to the Master so if an additional attribute ever required then only need to update the master and all of the duplicate shapes would be updated at the same time

[visio]

tried using the example in this link https://learn.microsoft.com/en-us/office/vba/api/visio.page.dropmany which duplicates all master templates onto a page with the duplicate shapes having the same name, this is close but not quite there.

Wanting to duplicate a single master as multiple shapes but each with different names and use a driver file or list to speed things up.

Any help appreciated 

[Visisthebest]

How do you want the end result to look?

[wapperdude]

I re-worked the drop many code to work with a single master/shape.  The shape, in this code, is selected from the Document stencil.  Only the active page is targeted, but a For / Next loop could be used to do all pages and/or add pages.  Both the shape and number of placements are hard coded. 

HTH

Code

Sub Relicate()
'This macro duplicates a single master / shape on the active page for the desired number of times.number of times.
'Both the shape name and number of shapes are hard coded in this code example.
'At the end, in the immediate window, a summary is debug printed
'Code was re-worked from DropMany code example.
'Wapperdude

    Dim mShp As Visio.Master
    Dim iCnt As Integer
    Dim numShps As Integer
    Dim aintIDArray() As Integer
    Dim intProcessed As Integer
     
    iCnt = 1
    numShps = 5     'Enter number of shapes per page
            
    Set mShp = Documents.Item("Drawing1").Masters.ItemU("Square")
'    Debug.Print mShp.Name
      
    ReDim varObjectsToInstance(1 To numShps) As Variant
    ReDim adblXYArray(1 To numShps * 2) As Double
    
    For iCnt = 1 To numShps
'   Pass name of object to drop to DropMany.
        varObjectsToInstance(iCnt) = mShp.Name
     
'   Set x components of where to drop to 2,4,6,2,4,6,2,4,6,...
        adblXYArray(iCnt * 2 - 1) = (((iCnt - 1) Mod 3) + 1) * 2
     
'   Set y components to 2,2,2,4,4,4,6,6,6,...
        adblXYArray(iCnt * 2) = Int((iCnt + 2) / 3) * 2
    Next iCnt
     
    intProcessed = ThisDocument.Pages(1).DropMany(varObjectsToInstance, adblXYArray, aintIDArray)

    Debug.Print "Number of shapes Processed:  " & intProcessed
    Debug.Print "Shp" & Chr(9) & "ID"
     
    For iCnt = LBound(aintIDArray) To UBound(aintIDArray)
        Debug.Print iCnt & Chr(9) & aintIDArray(iCnt)
    Next iCnt
  
End Sub

[wapperdude]

As I think about this, if you need to name each dropped shape, drop many may be wrong method.  The core name of each placement is the reference.  Each subsequent shape has an incremented ID.  The arrays store only Base namre, location, and ID.   So It would then be necessary to iterate all of the placed shapes to rename them.

You could write custom code to enable custom naming.  Generally, it's not a preferred method to use custom shape names.  There are some issues.  Rather, the more common practice is to put a reference designation identifier into shapesheet.

[visio]

The maser shape is a smart shape which represents a standard process and each of the duplicated shapes would represent another process.

The idea is to map an entire process suite which consists of many processes duplicated from the standard process.  So each of duplicates would have their own name and be on the same page. then they would position themselves and resize themselves based on the data.

The page links are done via the shape name thus the need to rename the duplicates.

[Visisthebest]

How do you want the end result to look, if you make a mock up then we can understand what you want to achieve!

[Yacine]

As I think about this, if you need to name each dropped shape, drop many may be wrong method.

My first reaction was to write "why use shape names at all? Use custom properties". But that is not really right. Using shape names help accessing them directly instead of iterating over all shapes. Thus much faster code.


But it is legimate to rename the shapes once, following arbitrary rules - eg: this_and_that_number_ID_Time_or_whatever. The naming could even be performed on the base of prop fields and especially based on the x,y coordinates, that are known from the DropMany arguments.
The arrays would ideally be built from a table (Excel) holding not only the coordinate, but also an ID.

So you'll have once a somewhat longer execution time, but only once - at creation time. Afterwards, you're again at it with accessing the shapes by their name.


"Name", not "NameU".

[visio]

Attached is what is desired using some test data.

This was actually created in 2014 using Smart Shapes based on the Trilogy post on this site. Looking to redo this using with more shapes and up to date code as it was so successful.

[wapperdude]

Updated the macro to have better comments, add custom names, and display names.

The code would need to be modified to get data from, e.g., an Excel file, such as shape name, placement location.

Code

Sub DupMany()
'This macro duplicates a single master / shape on the active page for the desired number of times.
'Both the shape name and number of shapes are hard coded in this code example.
'At the end, in the immediate window, a summary is debug printed

'Code was re-worked from the DropMany code example.
'DropMany does not accommodate shape naming.  So naming happens after placement.
'Instead of DropMany, use DROP inside a loop.  Each shape could be named before dropping.

'Wapperdude

    Dim mShp As Visio.Master
    Dim iCnt As Integer
    Dim numShps As Integer
    Dim aintIDArray() As Integer
    Dim intProcessed As Integer
    Dim vChars As Characters
     
    iCnt = 1
    numShps = 15     'Enter number of shapes per page
    
'This is where MAIN shape to be duplicated is entered
'This example pulls it from Document stencil ...must already be there
    Set mShp = Documents.Item("DropMany.vsdm").Masters.ItemU("Square")
    Debug.Print mShp.Name
      
    ReDim varObjectsToInstance(1 To numShps) As Variant
    ReDim adblXYArray(1 To numShps * 2) As Double
    
'Populate the arrays with main shape(s), location, and shape IDs
    For iCnt = 1 To numShps
'   Pass name of object to drop to DropMany.
        varObjectsToInstance(iCnt) = mShp.Name
     
'Change following placement routine as desired.  Read in specific values???
'   Set x components of where to drop to 2,4,6,2,4,6,2,4,6,...
        adblXYArray(iCnt * 2 - 1) = (((iCnt - 1) Mod 3) + 1) * 2
     
'   Set y components to 2,2,2,4,4,4,6,6,6,...
        adblXYArray(iCnt * 2) = Int((iCnt + 2) / 3) * 2
    Next iCnt
    
'Place the shapes.  DropMany does all at once...the Main shape and its duplicates.  NO naming!!!
    intProcessed = ThisDocument.Pages(1).DropMany(varObjectsToInstance, adblXYArray, aintIDArray)
    ActiveWindow.Page.CenterDrawing
     
'Assign name to each shape and display it here.
'This loop gets modified to read name from some place
'NOTE:  only name a shape once to avoid issues of "Name" vs "NameU"
    iCnt = 1
    For Each vShp In ActivePage.Shapes
        If Not vShp.OneD Then                         'ignore 1D shapes
            vShp.Name = "Name_" & iCnt           'the desired name is entered here

'   Display shape name
            Set vChars = vShp.Characters
            vChars.Begin = 0
            vChars.End = 0
            vChars.AddFieldEx visFCatObject, visFCodeObjectName, visFmtStrNormal, 1033, 0
        End If
        iCnt = iCnt + 1
    Next
        
        Debug.Print "Number of shapes Processed:  " & intProcessed
        Debug.Print "Shp" & Chr(9) & "ID" & Chr(9) & "Name"
     
    For iCnt = LBound(aintIDArray) To UBound(aintIDArray)
        Set vShp = ActivePage.Shapes.ItemFromID(aintIDArray(iCnt))
        Debug.Print iCnt & Chr(9) & aintIDArray(iCnt) & Chr(9) & vShp.Name
    Next iCnt
     
End Sub

[wapperdude]

One more modification.  The code does placements for landscape orientation, and places the shapes from left to right, top to bottom.

Code

Sub DupManyLand()
'This macro duplicates a single master / shape on the active page for the desired number of times.
'Both the shape name and number of shapes are hard coded in this code example.
'At the end, in the immediate window, a summary is debug printed
'Code was re-worked from DropMany code example.

Update:  The code does landscape orientation, starting left to right, top to bottom.
'Wapperdude

    Dim mShp As Visio.Master
    Dim iCnt As Integer
    Dim numShps As Integer
    Dim aintIDArray() As Integer
    Dim intProcessed As Integer
    Dim vChars As Characters
     
    iCnt = 1
    numShps = 15     'Enter number of shapes per page
            
    Set mShp = Documents.Item("DropMany.vsdm").Masters.ItemU("Square")
    Debug.Print mShp.Name
      
    ReDim varObjectsToInstance(1 To numShps) As Variant
    ReDim adblXYArray(1 To numShps * 2) As Double
    
'Populate the arrays with main shape(s), location, and shape IDs
    For iCnt = 1 To numShps
'   Pass name of object to drop to DropMany.
        varObjectsToInstance(iCnt) = mShp.Name
     
'Change following placeme   routine as desired
'   Set x components of where to drop to 2,4,6,2,4,6,2,4,6,...
        adblXYArray(iCnt * 2 - 1) = (((iCnt - 1) Mod 5) + 1) * 2
     
'   Set y components to 2,2,2,4,4,4,6,6,6,...
        adblXYArray(iCnt * 2) = 8 - (Int((iCnt + 4) / 5)) * 2
    Next iCnt
    
'Place the shapes
    intProcessed = ThisDocument.Pages(1).DropMany(varObjectsToInstance, adblXYArray, aintIDArray)
    ActiveWindow.Page.CenterDrawing
     
'Assign name to shape and display here.
'This loop gets modified to read name from someplace
'Only name a shape once to avoid issues of Name and NameU
    iCnt = 1
    For Each vShp In ActivePage.Shapes
        If Not vShp.OneD Then
            vShp.Name = "Name_" & iCnt
            Set vChars = vShp.Characters
            vChars.Begin = 0
            vChars.End = 0
            vChars.AddFieldEx visFCatObject, visFCodeObjectName, visFmtStrNormal, 1033, 0
        End If
        iCnt = iCnt + 1
    Next
        
        Debug.Print "Number of shapes Processed:  " & intProcessed
        Debug.Print "Shp" & Chr(9) & "ID" & Chr(9) & "Name"
     
    For iCnt = LBound(aintIDArray) To UBound(aintIDArray)
        Set vShp = ActivePage.Shapes.ItemFromID(aintIDArray(iCnt))
        Debug.Print iCnt & Chr(9) & aintIDArray(iCnt) & Chr(9) & vShp.Name & Chr(9) & adblXYArray((iCnt + 1) * 2 - 1) & Chr(9) & adblXYArray((iCnt + 1) * 2)
    Next iCnt
     
End Sub