Close OpenSheetWindow utilizing VBA in Visio 2010

Question

I was able to create a VBA Macro yesterday by reading the great questions and answers. I am extremely new to working with VBA in Visio 2010. A little background, I am an engineer and am now constantly working with very large Visio drawings where all shapes are populated with shape data. Due to security reasons, some of the easy ways to delete the shape data when refreshing are not available for use. I worked on a VBA script yesterday and finally was able to get a Macro to search the shape data of the object I selected and delete the field I asked it to do. My only problem is that since I was utilizing different pieces of code from this forum, I don't know how to perform the final step.
The Macro currently is deleting upwards of 27 shape data fields and the code I got to work opens a Sheet Window for every field it deletes and leaves it open. What I want it to do is after it deletes the field, it closes the Sheet Window. Below is the code I am utilizing.

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._VisDM_Manufacturer", Visio.VisExistsFlags.visExistsAnywhere) Then
    Dim a As Visio.Cell
    Set a = selectObj.Cells("Prop._VisDM_Manufacturer")
    Dim var1 As Visio.Window
    Set win = selectObj.OpenSheetWindow
    win.Shape.DeleteRow visSectionProp, a.Row
Else
    End If

If selectObj.CellExists("Prop._VisDM_Model", Visio.VisExistsFlags.visExistsAnywhere) Then
    Dim b As Visio.Cell
    Set b = selectObj.Cells("Prop._VisDM_Model")
    Dim var2 As Visio.Window
    Set win = selectObj.OpenSheetWindow
    win.Shape.DeleteRow visSectionProp, b.Row
Else
    End If

If selectObj.CellExists("Prop._VisDM_Product_Number", Visio.VisExistsFlags.visExistsAnywhere) Then
    Dim c As Visio.Cell
    Set c = selectObj.Cells("Prop._VisDM_Product_Number")
    Dim var3 As Visio.Window
    Set win = selectObj.OpenSheetWindow
    win.Shape.DeleteRow visSectionProp, c.Row
Else
    End If

If selectObj.CellExists("Prop._VisDM_Functional_Description", Visio.VisExistsFlags.visExistsAnywhere) Then
    Dim d As Visio.Cell
    Set d = selectObj.Cells("Prop._VisDM_Functional_Description")
    Dim var4 As Visio.Window
    Set win = selectObj.OpenSheetWindow
    win.Shape.DeleteRow visSectionProp, d.Row
Else
    End If

If selectObj.CellExists("Prop._VisDM_Network_ID", Visio.VisExistsFlags.visExistsAnywhere) Then
    Dim e As Visio.Cell
    Set e = selectObj.Cells("Prop._VisDM_Network_ID")
    Dim var5 As Visio.Window
    Set win = selectObj.OpenSheetWindow
    win.Shape.DeleteRow visSectionProp, e.Row
Else
    End If

If selectObj.CellExists("Prop._VisDM_MAC_Address", Visio.VisExistsFlags.visExistsAnywhere) Then
    Dim f As Visio.Cell
    Set f = selectObj.Cells("Prop._VisDM_MAC_Address")
    Dim var6 As Visio.Window
    Set win = selectObj.OpenSheetWindow
    win.Shape.DeleteRow visSectionProp, f.Row
Else
    End If

If selectObj.CellExists("Prop._VisDM_Number_of_Ports", Visio.VisExistsFlags.visExistsAnywhere) Then
    Dim g As Visio.Cell
    Set g = selectObj.Cells("Prop._VisDM_Number_of_Ports")
    Dim var7 As Visio.Window
    Set win = selectObj.OpenSheetWindow
    win.Shape.DeleteRow visSectionProp, g.Row
Else
    End If

If selectObj.CellExists("Prop._VisDM_Operating_System", Visio.VisExistsFlags.visExistsAnywhere) Then
    Dim h As Visio.Cell
    Set h = selectObj.Cells("Prop._VisDM_Operating_System")
    Dim var8 As Visio.Window
    Set win = selectObj.OpenSheetWindow
    win.Shape.DeleteRow visSectionProp, h.Row
Else
    End If

If selectObj.CellExists("Prop._VisDM_Operating_System_Version", Visio.VisExistsFlags.visExistsAnywhere) Then
    Dim i As Visio.Cell
    Set i = selectObj.Cells("Prop._VisDM_Operating_System_Version")
    Dim var9 As Visio.Window
    Set win = selectObj.OpenSheetWindow
    win.Shape.DeleteRow visSectionProp, i.Row
Else
    End If

If selectObj.CellExists("Prop._VisDM_Floor", Visio.VisExistsFlags.visExistsAnywhere) Then
    Dim j As Visio.Cell
    Set j = selectObj.Cells("Prop._VisDM_Floor")
    Dim var10 As Visio.Window
    Set win = selectObj.OpenSheetWindow
    win.Shape.DeleteRow visSectionProp, j.Row
Else
    End If

If selectObj.CellExists("Prop._VisDM_Room", Visio.VisExistsFlags.visExistsAnywhere) Then
    Dim k As Visio.Cell
    Set k = selectObj.Cells("Prop._VisDM_Room")
    Dim var11 As Visio.Window
    Set win = selectObj.OpenSheetWindow
    win.Shape.DeleteRow visSectionProp, k.Row
Else
    End If

If selectObj.CellExists("Prop._VisDM_Rack", Visio.VisExistsFlags.visExistsAnywhere) Then
    Dim l As Visio.Cell
    Set l = selectObj.Cells("Prop._VisDM_Rack")
    Dim var12 As Visio.Window
    Set win = selectObj.OpenSheetWindow
    win.Shape.DeleteRow visSectionProp, l.Row
Else
    End If

If selectObj.CellExists("Prop._VisDM_Rack_Elevation", Visio.VisExistsFlags.visExistsAnywhere) Then
    Dim m As Visio.Cell
    Set m = selectObj.Cells("Prop._VisDM_Rack_Elevation")
    Dim var13 As Visio.Window
    Set win = selectObj.OpenSheetWindow
    win.Shape.DeleteRow visSectionProp, m.Row
Else
    End If

If selectObj.CellExists("Prop._VisDM_System_Environment", Visio.VisExistsFlags.visExistsAnywhere) Then
    Dim n As Visio.Cell
    Set n = selectObj.Cells("Prop._VisDM_System_Environment")
    Dim var14 As Visio.Window
    Set win = selectObj.OpenSheetWindow
    win.Shape.DeleteRow visSectionProp, n.Row
Else
    End If

If selectObj.CellExists("Prop._VisDM_Installation", Visio.VisExistsFlags.visExistsAnywhere) Then
    Dim o As Visio.Cell
    Set o = selectObj.Cells("Prop._VisDM_Installation")
    Dim var15 As Visio.Window
    Set win = selectObj.OpenSheetWindow
    win.Shape.DeleteRow visSectionProp, o.Row
Else
    End If

If selectObj.CellExists("Prop._VisDM_MAGTF_IT_Support_Center", Visio.VisExistsFlags.visExistsAnywhere) Then
    Dim p As Visio.Cell
    Set p = selectObj.Cells("Prop._VisDM_MAGTF_IT_Support_Center")
    Dim var16 As Visio.Window
    Set win = selectObj.OpenSheetWindow
    win.Shape.DeleteRow visSectionProp, p.Row
Else
    End If

If selectObj.CellExists("Prop._VisDM_Major_Command", Visio.VisExistsFlags.visExistsAnywhere) Then
    Dim q As Visio.Cell
    Set q = selectObj.Cells("Prop._VisDM_Major_Command")
    Dim var17 As Visio.Window
    Set win = selectObj.OpenSheetWindow
    win.Shape.DeleteRow visSectionProp, q.Row
Else
    End If

If selectObj.CellExists("Prop._VisDM_Major_Subordinate_Command_MSC", Visio.VisExistsFlags.visExistsAnywhere) Then
    Dim r As Visio.Cell
    Set r = selectObj.Cells("Prop._VisDM_Major_Subordinate_Command_MSC")
    Dim var18 As Visio.Window
    Set win = selectObj.OpenSheetWindow
    win.Shape.DeleteRow visSectionProp, r.Row
Else
    End If

If selectObj.CellExists("Prop._VisDM_Facilities_Maintenance_Organization", Visio.VisExistsFlags.visExistsAnywhere) Then
    Dim s As Visio.Cell
    Set s = selectObj.Cells("Prop._VisDM_Facilities_Maintenance_Organization")
    Dim var19 As Visio.Window
    Set win = selectObj.OpenSheetWindow
    win.Shape.DeleteRow visSectionProp, s.Row
Else
    End If

If selectObj.CellExists("Prop._VisDM_Organization_UIC", Visio.VisExistsFlags.visExistsAnywhere) Then
    Dim t As Visio.Cell
    Set t = selectObj.Cells("Prop._VisDM_Organization_UIC")
    Dim var20 As Visio.Window
    Set win = selectObj.OpenSheetWindow
    win.Shape.DeleteRow visSectionProp, t.Row
Else
    End If

If selectObj.CellExists("Prop._VisDM_PSI_Code", Visio.VisExistsFlags.visExistsAnywhere) Then
    Dim u As Visio.Cell
    Set u = selectObj.Cells("Prop._VisDM_PSI_Code")
    Dim var21 As Visio.Window
    Set win = selectObj.OpenSheetWindow
    win.Shape.DeleteRow visSectionProp, u.Row
Else
    End If

If selectObj.CellExists("Prop._VisDM_Unit_Name", Visio.VisExistsFlags.visExistsAnywhere) Then
    Dim v As Visio.Cell
    Set v = selectObj.Cells("Prop._VisDM_Unit_Name")
    Dim var22 As Visio.Window
    Set win = selectObj.OpenSheetWindow
    win.Shape.DeleteRow visSectionProp, v.Row
Else
    End If

If selectObj.CellExists("Prop._VisDM_Operating_Organization", Visio.VisExistsFlags.visExistsAnywhere) Then
    Dim w As Visio.Cell
    Set w = selectObj.Cells("Prop._VisDM_Operating_Organization")
    Dim var23 As Visio.Window
    Set win = selectObj.OpenSheetWindow
    win.Shape.DeleteRow visSectionProp, w.Row
Else
    End If

If selectObj.CellExists("Prop._VisDM_Building_Number", Visio.VisExistsFlags.visExistsAnywhere) Then
    Dim x As Visio.Cell
    Set x = selectObj.Cells("Prop._VisDM_Building_Number")
    Dim var24 As Visio.Window
    Set win = selectObj.OpenSheetWindow
    win.Shape.DeleteRow visSectionProp, x.Row
Else
    End If

If selectObj.CellExists("Prop._VisDM_Program_of_Record", Visio.VisExistsFlags.visExistsAnywhere) Then
    Dim y As Visio.Cell
    Set y = selectObj.Cells("Prop._VisDM_Program_of_Record")
    Dim var25 As Visio.Window
    Set win = selectObj.OpenSheetWindow
    win.Shape.DeleteRow visSectionProp, y.Row
Else
    End If

If selectObj.CellExists("Prop._VisDM_Program_Office", Visio.VisExistsFlags.visExistsAnywhere) Then
    Dim z As Visio.Cell
    Set z = selectObj.Cells("Prop._VisDM_Program_Office")
    Dim var26 As Visio.Window
    Set win = selectObj.OpenSheetWindow
    win.Shape.DeleteRow visSectionProp, z.Row
Else
    End If

If selectObj.CellExists("Prop._VisDM_Reference_ID", Visio.VisExistsFlags.visExistsAnywhere) Then
    Dim az As Visio.Cell
    Set az = selectObj.Cells("Prop._VisDM_Reference_ID")
    Dim var27 As Visio.Window
    Set win = selectObj.OpenSheetWindow
    win.Shape.DeleteRow visSectionProp, az.Row
Else
    End If

If selectObj.CellExists("Prop._VisDM_SONIC_LCID", Visio.VisExistsFlags.visExistsAnywhere) Then
    Dim bz As Visio.Cell
    Set bz = selectObj.Cells("Prop._VisDM_SONIC_LCID")
    Dim var28 As Visio.Window
    Set win = selectObj.OpenSheetWindow
    win.Shape.DeleteRow visSectionProp, bz.Row
Else
    End If

End Sub

So as you can see, Set win = selectObj.OpenSheetWindow opens the Visio Shape Data Sheet however after executing win.Shape.DeleteRow visSectionProp, bz.Row it leaves the Sheet Window open; I would like it to close.

score 1 · Answer 1 · answered Oct 06 '15 at 12:42

To answer your question directly, you already have a window object (win), so you just call the Close method on it.

However, you shouldn't really need to open the window in the first place. Take a look at this alternative:

Const EXAMPLE_CELL_NAMES = "Prop._VisDM_Manufacturer;Prop._VisDM_Model;Prop._VisDM_Product_Number;Prop._VisDM_Functional_Description;Prop._VisDM_Network_ID"


Sub DeleteShapeData()
If ActiveWindow.Selection.Count = 0 Then
    MsgBox "You must select a shape first."
Else
    Dim arrCellNames() As String
    arrCellNames = Split(EXAMPLE_CELL_NAMES, ";")

    Dim shp As Visio.Shape
    For Each shp In ActiveWindow.Selection
        Dim i As Integer
        For i = LBound(arrCellNames) To UBound(arrCellNames)
            Call DeleteContainingRow(shp, arrCellNames(i))
        Next
    Next shp
End If
End Sub


Private Sub DeleteContainingRow(ByRef shpIn As Visio.Shape, cellName As String)
If Not shpIn Is Nothing Then
    If shpIn.CellExistsU(cellName, Visio.VisExistsFlags.visExistsAnywhere) Then
        Dim targetCell As Visio.Cell
        Set targetCell = shpIn.CellsU(cellName)
        shpIn.DeleteRow targetCell.Section, targetCell.Row
    End If
End If
End Sub

Close OpenSheetWindow utilizing VBA in Visio 2010

1 Answers1