Duplicating a page with a macro assigned command button.

[MrBungle]

Hi there,

longtime lurker, first time poster.

I am using visio 2016 with windows 7.

I've found and repurposed a bit of code that allows me to generate a Bill of materials into an existing excel object.  Specifically from:  http://www.visguy.com/2007/06/03/sales-force-automation-with-visio/

I do HVAC Drawings, so i typically have a bunch of pages that could use a BOM per system.  With the above code, the command button and the Excel object "BOM" works great.  If i duplicate the page, it no longer works.  clicking the button does no action. 

Repurposed code posted below:

Code Select Expand


Sub ClearExcelEmbeddedObject()

    'This sub clears the embedded Excel spreadsheet.
   
    Dim xlSheet As Excel.Worksheet
       
    Set xlSheet = ActivePage.Shapes("BOM").Object.Worksheets(1)
   
    'Select a very large range, and clear the contents:
    xlSheet.Range("A2:C500").ClearContents
    xlSheet.Range("e2:e500").ClearContents
   
    'Let's do some formatting as well:
    'Whole sheet, left-aligned
    'xlSheet.Range("A1:C500").HorizontalAlignment = xlLeft
   
    'Last column's data, right-aligned:
    'xlSheet.Range("D1:D500").HorizontalAlignment = xlLeft
   
    'Clear all Bold:
    'xlSheet.Range("A2:D500").Font.Bold = False
   
End Sub

Sub SendBOMDataToExcel()

    'This sub exports drawing data to the embedded Excel spreadsheet.
   
    Dim xlSheet As Excel.Worksheet
    Dim iXLRowNum As Integer, i As Integer
    Dim shp As Visio.Shape
       
    'First, clear out the existing spreadsheet, in case there's more
    'stuff there than we'll end up with:
    Call ClearExcelEmbeddedObject
       
    Set xlSheet = ActivePage.Shapes("BOM").Object.Worksheets(1)
    iXLRowNum = 2
   
    For i = 1 To ActivePage.Shapes.Count
        Set shp = ActivePage.Shapes.Item(i)
        With shp
            'Check Data1 field of each shape to see if it contains the
            'the string "Candy Equipment". This is how we screen for
            'equipment shapes that we care about.
            If shp.CellExists("prop._VisDM_Address", 0) Then
           
                'Other neat ways to screen for shapes include: assigning shapes
                'to specific layers, or using user cells such as User.Class =
                '"Equipment", or simply checking for the existance of an empty
                'User.Equipment cell.
               
                'Add data to spreadsheet.
                'Master name:
                If .CellExists("Prop._VisDM_Mnemonic", 0) Then xlSheet.Range("A" & LTrim(Str(iXLRowNum))).Value = .Cells("Prop._VisDM_Mnemonic").ResultStr(visNoCast)
                'Manufacturing line:
                If .CellExists("Prop._VisDM_Device_Type", 0) Then xlSheet.Range("B" & LTrim(Str(iXLRowNum))).Value = .Cells("Prop._VisDM_Device_Type").ResultStr(visNoCast)
                'Model number:
                If .CellExists("Prop._VisDM_Device_Description", 0) Then xlSheet.Range("C" & LTrim(Str(iXLRowNum))).Value = .Cells("Prop._VisDM_Device_Description").ResultStr(visNoCast)
               
               
                'Increment Excel row-tracking variable:
                iXLRowNum = iXLRowNum + 1
               
               
                'xlSheet.Range("C" & LTrim(Str(iXLRowNum))).Formula = .Cells("prop.Duration").Result("em")
                'xlSheet.Range("D" & LTrim(Str(iXLRowNum))).Formula = .Cells("prop.Resources").Result(visNumber)
                'xlSheet.Range("E" & LTrim(Str(iXLRowNum))).Formula = .Name
            End If
               
        End With
       
    Next i
    xlSheet.Range("B:B").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=xlSheet.Range("E1"), Unique:=True
    'xlSheet.Range("C:C").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=xlSheet.Range("E2"), Unique:=True
   
       
 

End Sub




Thanks in advance!

[Yacine]

Just guessing...
1) you trigger the macro by means of an activex button. They lose their allocation when duplicated. Haven't tried it with page duplication though. But you can check the properties of the button on the duplicated page. Work around: use a regular shape and assign an action ("callthis") to its double-click event.
2) you're referring to the excel object as "BOM". The name should be kept when duplicating pages, but check anyway the name of the excel shape on the duplicated page. Workaround: use a user cell to identify the BOM shape.

[MrBungle]

Hi Yacine,

1) you trigger the macro by means of an activex button. They lose their allocation when duplicated. Haven't tried it with page duplication though. But you can check the properties of the button on the duplicated page. Work around: use a regular shape and assign an action ("callthis") to its double-click event.

Yes, and it looks like your assumption is true with page duplication.  Your workaround using an object do double click is working fine so i'm going to go with this.

2) you're referring to the excel object as "BOM". The name should be kept when duplicating pages, but check anyway the name of the excel shape on the duplicated page. Workaround: use a user cell to identify the BOM shape.

duplicating the "BOM" Object seems to keep it's name consistent when duplicating pages.  It only changes if i drag more than one "BOM" out onto the page.  But, you only need one BOM at a time so it probably won't be an issue unless someone else does this and deletes the original.   Maybe going with a usercell might be a way to bullet proof it a bit better for the future.   Then it won't matter which instance is created or deleted.

Thanks for your help, consider the mystery solved.