delete shape data using VBA

[kazman]

Hi Guy's

Wondering if anyone can help, I am looking for a way to delete the automatic shape data created when using Visio's org chart feature

I have already have a macro that inserts the shape data that I need into the selected shape

My problem happens When dragging a new shape from the Shapes Data Window the shape will come prepoplated with some default shape data used by Visio Hierarchy Structure document (e.g. Name, department, email etc) these will need to be removed manually

is anyone aware how to do this using VBA

[aledlund]

That data is populated in the master (the shape in the stencil) and then corrected by the orgchart add-in code. You might create your own stencil/masters with the data gone.
al

[kazman]

hi Al

Thanks for the advice, sadly I need to use the stencils as I'm reliant on a few of the features provide by the org chart add in,

I have created a representation of directory structure using the org chart feature plus the document already has 120 pages and would mean changing the existing shapes I already have.

The document is essentially complete, I'm at the point where I am writing the support guide which is why i thought it would be useful if there was a macro to remove the default shape data and another macro to add the required shape data (already written)

[kazman]

managed to work it out, here's the solution I used, In the end I had to define the rows I wanted to remove, so it's not dynamic, but it works for what I need, running this macro will remove the shape data from the currently selected shape

Sub DeleteRow()

Dim winObj4 As Visio.Window
   Dim shpObj4 As Visio.Shape
   Dim selectObj4 As Visio.Selection
   Dim celObj4 As Visio.Cell
   Dim celFormula4, MasterName2 As String
   Set selectObj4 = Visio.ActiveWindow.Selection
   If selectObj4.Count = 0 Then
      MsgBox "You must select the shape before running this macro."
   Else
   Set shpObj4 = selectObj4(1)
'   shpObj4.DeleteRow visSectionProp, "Department"
'  shpObj4.AddRow visSectionScratch, visRowScratch, 0
    shpObj4.DeleteRow visSectionProp, shpObj4.CellsU("Prop.Department").Row
    shpObj4.DeleteRow visSectionProp, shpObj4.CellsU("Prop.Telephone").Row
    shpObj4.DeleteRow visSectionProp, shpObj4.CellsU("Prop.Name").Row
    shpObj4.DeleteRow visSectionProp, shpObj4.CellsU("Prop.Title").Row
    shpObj4.DeleteRow visSectionProp, shpObj4.CellsU("Prop.Email").Row


   End If
   
End Sub

[Jumpy]

Some ideas for a better code:

Code Select Expand


If selectObj4.Count = 0 Then
      MsgBox "You must select the shape before running this macro."
ElseIf selectObj4.Count >1 Then
      MsgBox "Please select only one shape before running this macro."
Else
  Set shpObj4 = selectObj4(1)
  If shpObj4.CellExists("Prop.Department",false)   then _
    shpObj4.DeleteRow visSectionProp, shpObj4.CellsU("Prop.Department").Row
  If shpObj4.CellExists("Prop.Telephone",false)   then _
    shpObj4.DeleteRow visSectionProp, shpObj4.CellsU("Prop.Telephone").Row
  '...
End If


Try to foresee what problems/exceptions might accure.

[kazman]

thanks Jumpy,

good advice, your right no matter how tech competent the end user will be best to cover the bases

thanks again