VBA for macro to delete shapesheet data

[PhilEdinburgh]

Hi All,

I am very new to vba code and even newer to MS Visio. It'd be great if someone could help me out with some trouble I've been having.

BACKGROUND - I am creating shapes that represent water valves in schematics, each shape has several data fields behind it ie. Asset ID, valve diameter, etc. When updating these these shapes I have been using a shape substitute Add-on, unfortunately I must copy either 'All' or 'None' of the user defined cells from the original shape, leaving me with multiple fields of shape data that I do not want.

PROBLEM - I am left with shapes that have numerous fields of shape data, I need a macro that will act on highlighted shapes and delete datafields of my choosing. I have had a go (see below) at deleting the data field CritValve, I would really appreciate some help on this. Apologies for the basic code, I am still trying to make sense of it all. When I run this I am presented with the error; Object doesn't support this property or method and it highlights the line:
'If selectObj.CellExists("Prop.CritValve", Visio.VisExistsFlags.visExistsAnywhere) Then.

Sub DeleteShapeData()

' Set object as selected object
Set selectObj = ActiveWindow.Selection
If selectObj.Count = 0 Then
    MsgBox "You must select a shape first."
Else
    'continue processing
End If

'Search for the cell I wish to delete in the shapesheet
If selectObj.CellExists("Prop.CritValve", Visio.VisExistsFlags.visExistsAnywhere) Then
Dim c As Visio.Cell
Set c = selectObj.CellExists("Prop.CritValve")
selectObj.DeletRow c.Section, c.Row
Else

End If


End Sub

[JuneTheSecond]

Please try next
But for window name in the line
"Application.Windows.ItemEx("図面1:ページ - 1:Sheet.1 <図形>").Activate"
, please modify for your Visio language.
I recommend you to get code by recording a macro while you deleting the row.

Code Select Expand



Sub DeleteShapeData()

Dim selectObj As Visio.Shape

' Set object as selected object
If ActiveWindow.Selection.Count = 0 Then
    MsgBox "You must select a shape first."
    Exit Sub
Else
    Set selectObj = ActiveWindow.Selection(1)
End If

'Search for the cell I wish to delete in the shapesheet
If selectObj.CellExists("Prop.CritValve", Visio.VisExistsFlags.visExistsAnywhere) Then
    Dim c As Visio.Cell
    Set c = selectObj.Cells("Prop.CritValve")
    Application.Windows.ItemEx("図面1:ページ - 1:Sheet.1 <図形>").Activate
    Application.ActiveWindow.Shape.DeleteRow visSectionProp, c.Row
Else

End If


End Sub



Or If you would like the code you don't need to modify.

Code Select Expand



Option Explicit

Sub DeleteShapeData()

Dim selectObj As Visio.Shape

' Set object as selected object
If ActiveWindow.Selection.Count = 0 Then
    MsgBox "You must select a shape first."
    Exit Sub
Else
    Set selectObj = ActiveWindow.Selection(1)
End If

'Search for the cell I wish to delete in the shapesheet
If selectObj.CellExists("Prop.CritValve", Visio.VisExistsFlags.visExistsAnywhere) Then
    Dim c As Visio.Cell
    Set c = selectObj.Cells("Prop.CritValve")
    Dim win As Visio.Window
    Set win = selectObj.OpenSheetWindow
    win.Shape.DeleteRow visSectionProp, c.Row
 
Else

End If


End Sub





[Yacine]

Hi Phil,
a first good solution would be to have a dialog which reads the fields of the source shape, sets them in check fields or a multiple selection list and lets the user chose the fields to copy to the target shape.
The second better solution would be to have two dialogs. The first one would set up the new shape as you need it. Which is, to assign it to a custom properties set and may be further modifications that you would like to do with the new shape (colour, layer, etc.).
The second dialog would have two fields and buttons. One to define the source by selecting it, then pushing the "select source" button and the other for the target. A third "assign" or "copy" button, would then just copy the fields that are already in the target shape.
This would have the advantage that the user has less options to do something wrong.
For a fluent workflow both dialogs would be non modal.
HTH,
Yacine

[PhilEdinburgh]

Hi Guys,

Thanks for both replies, very helpful. Yacine your solution sounds ideal but I'm afraid is beyond my skill.

JuneTheSecond, based on your second solution I have the code below working fantastically thank you, my only problem is that I need the macro to act on all shapes selected, currently the row is deleted only from the first selected shape. Is there a simple way to expand the code to cover all shapes selected at the point of execution?
Many thanks
Phil

code currently working:

Sub DeleteShapeData()
Dim selectObj As Visio.Shape

If ActiveWindow.Selection.Count = 0 Then
    MsgBox "You must select a shape first."
    Exit Sub
Else
    Set selectObj = ActiveWindow.Selection(1)
End If

'Search for the cell I wish to delete in the shapesheet
If selectObj.CellExists("Prop.CritValve", Visio.VisExistsFlags.visExistsAnywhere) Then
    Dim c As Visio.Cell
    Set c = selectObj.Cells("Prop.CritValve")
    Dim win As Visio.Window
    Set win = selectObj.OpenSheetWindow
    win.Shape.DeleteRow visSectionProp, c.Row
Else

End If
End Sub

[JuneTheSecond]

The point is only to add "For loops".

Fortunatery, in this case next loops work well.

For Each selectObj In ActiveWindow.Selection
    .................
Next

Code Select Expand



Sub DeleteShapeData()

Dim selectObj As Visio.Shape

' Set object as selected objects.
If ActiveWindow.Selection.Count = 0 Then
    MsgBox "You must select shapes first."
    Exit Sub
End If

'Search for the cell I wish to delete in the shapesheet
For Each selectObj In ActiveWindow.Selection
    If selectObj.CellExists("Prop.CritValve", Visio.VisExistsFlags.visExistsAnywhere) Then
        Dim c As Visio.Cell
        Set c = selectObj.Cells("Prop.CritValve")
        Dim win As Visio.Window
        Set win = selectObj.OpenSheetWindow
        win.Shape.DeleteRow visSectionProp, c.Row
        win.Close
    End If
Next

End Sub



[PhilEdinburgh]

Thank you, works perfectly 

[brrrknee]

good info. 
I have noticed that since I had created a particular set of code that worked with Visio Org Chart imported Excel data, originally on office/visio 2003 and continuing on now thru 2007, 2010 and 2013, there are certain excel-column-name (top row of imported excel) fields that persist and accumulate.
I have code in modules affixed to this file, which is a template of my org-chart efforts.  Does having the (VBA) code modules cause this "long memory" or is it even more indirect (such as visio/org chart writing to the registry or other secret data file for latent refresh...)?
same tool works on 6-8 flavors of Excel file input,

• Proc
• Event
• Gap

etc.,
each having a mostly consistent format of columns:

• name unique to each of the types above:


• Proc name
• Event name
• Gap name
• entry ID
• parent
• depth

etc.,
and the Gap flavor has a few unique fields, like Gap Number.

I'd like to find a way to have only Gap fields in the Visio shapes on a Gap-imported Excel file.
Same for the others; unfortunately I end up with every single one of these fields in every shape of any type Excel I import.

Any ideas on how to clear these out to get a "clean as will be possible" template to start over without excess fields?
This has been a bit of a bother, but the above suggestions give me hope that I can find a way to clear it up once and for all.