Save Drawing with Name from Shape Data

[jatwork]

OK, I'm sure this is a really stupid question, but hopefully you folks can help.

I want to make a macro to save my drawing with a name that is pulled from the Shape Data of the one shape in my drawing. I've found the basis for what I want, but it is for Excel and uses a cell value as the save name.

My main problem is trying to figure out what my dang shape is called, and how to pull the info from it. I know this is

Here's the Excel VBA macro...

Code Select Expand

Sub SaveAsExample()
     
    Dim FName           As String
    Dim FPath           As String
     
    FPath = "C:"
    FName = Sheets("Sheet1").Range("A1").Text
    ThisWorkbook.SaveAs Filename:=FPath & "\" & FName
     
End Sub


I need to figure out what to put for the FName = ?? ??  to get the data out of my shape! It looks like Shape.CellsU property is the way to go, but I still can't figure out what my stupid shape is called haha.

Code Select Expand

[[WHAT GOES HERE AS MY SHAPE NAME?]].CellsU("Prop._VisDM_DrawTitle.Value")

I'll attach my example file. I've got the shape linked with an excel sheet. I already have it so when I drag a row from the data to the shape it updates everything in the drawing. I want to be able to hit my macro afterwards to save the drawing as the text that appears in the "Title" box. This text comes from the Shape Data under "Prop._VisDM_DrawTitle"

[wapperdude]

Hmmm.  I don't see any shape with any shape data.

Wapperdude

[Croc]

The page contains only one shape.

Code Select Expand

    Debug.Print ActivePage.Shapes(1).NameU
    Debug.Print ActivePage.Shapes("Circuit and Title Block").NameU

[jatwork]

Hmm do you see the shape Croc? The "Circuit and Title Block" is what the stencil was named. Did the linked data not get saved in the drawing? Guess I'll try again tomorrow morning.

[Croc]

See "Drawing Explorer" window.

[Surrogate]

short video how show/hide Drawing Explorer Window

[wapperdude]

To build shapesheet formulas with correct syntax, see this link, Elements of Visio Forumulas, https://msdn.microsoft.com/en-us/library/aa200961(office.10).aspx

For your VBA code, something like: 

Code Select Expand


Sub shpName()
    Dim shpName As Variant
    Dim vsoShp As Shape
   
'All of the following work:
    Set vsoShp = ActiveWindow.Selection(1)    'Assumes only desired shape is selected
'    Set vsoShp = ActivePage.Shapes.ItemFromID(1)   'Assumes, in this example, the shape is sheet.1
'    Set vsoShp = ActivePage.Shapes.Item("Circuit and Title Block")   'Least preferred, shape naming has issues

    shpName = vsoShp.CellsU("Prop._VisDM_DrawTitle").ResultStr(Visio.visNone)

    Debug.Print shpName
End Sub

Wapperdude

[jatwork]

Oh that's awesome wapperdude, thanks! I've used your first example and have it working like I want. I can definitely see how using the specific name of the shape could lead to trouble down the line. I'll read up on the documentation in your link.

Here's the working macro as it stands:

Code Select Expand

Sub SaveMeAsTitle()
    Dim vsoShp As Shape
    Dim FName As Variant
    Dim FPath As String

    'Assumes only desired shape is selected
    Set vsoShp = ActiveWindow.Selection(1)
    FName = vsoShp.CellsU("Prop._VisDM_DrawTitle").ResultStr(Visio.visNone)
    FPath = "H:\DATA\VISIO\Site Documentation\test\autosave\"
       
    ThisDocument.SaveAs FileName:=FPath & FName & ".vsd"
End Sub

Thanks
j

[jatwork]

Thought I'd reply back here with the little bit of code that was the endgame of this question. My original plan was to have a script go through a spreadsheet of circuit routes, tie an entry to a shape, save that, and then move on down the list repeating the steps. I first settled for just automating the save part and with the help of wapperdude's code, made that work. After lots of reading on MSDN plus ample trial and error, I've cobbled together some code that does what I want all in one go! Thanks again

Code Select Expand

Sub LinkDataSaveFile()

    Dim vsoDataRecordset As Visio.DataRecordset
    Dim intCount As Integer
    Dim lngRowIDs() As Long
    Dim lngRow As Long
    Dim vsoShp As Shape
    Dim FName As Variant
    Dim FPath As String

    intCount = ThisDocument.DataRecordsets.Count
    Set vsoDataRecordset = ThisDocument.DataRecordsets(intCount)
    lngRowIDs = vsoDataRecordset.GetDataRowIDs("")

    'Iterate through all the records in the data recordset.
    For lngRow = LBound(lngRowIDs) + 1 To UBound(lngRowIDs) + 1
       
        'links data from row to drawing
        ActivePage.Shapes.ItemFromID(1).LinkToData vsoDataRecordset, lngRow
        Set vsoShp = ActivePage.Shapes.ItemFromID(1)
        FName = vsoShp.CellsU("Prop._VisDM_DrawTitle").ResultStr(Visio.visNone)
        FPath = "C:\Visio Files\autosave\"
        ThisDocument.SaveAs FileName:=FPath & FName & ".vsd"
        Application.ActiveDocument.ExportAsFixedFormat visFixedFormatPDF, FPath & "PDFS\" & FName & ".pdf", visDocExIntentPrint, visPrintAll
        Debug.Print "Complete! - "; FPath; FName; ".vsd"

    Next lngRow
End Sub