Question

我昨天通过阅读很棒的问题和答案来创建VBA宏。我对在Visio 2010中使用VBA非常陌生。有一点背景，我是一名工程师，现在我正在使用非常大的Visio绘图，其中所有形状都填充了形状数据。由于安全原因，在刷新时删除形状数据的一些简单方法无法使用。我昨天在VBA脚本上工作，最后能够得到一个宏来搜索我选择的对象的形状数据并删除我要求它做的字段。我唯一的问题是，由于我在使用本论坛的不同代码，我不知道如何执行最后一步宏当前正在删除超过27个形状数据字段，我开始工作的代码为它删除的每个字段打开一个工作表窗口并使其保持打开状态。我想要它做的是删除字段后，它关闭工作表窗口。以下是我正在使用的代码。

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

正如您所看到的，Set win = selectObj.OpenSheetWindow打开Visio形状数据表，但在执行win.Shape.DeleteRow visSectionProp, bz.Row后，它会打开工作表窗口;我希望它能够结束。

Answer 1

要直接回答你的问题，你已经有了一个窗口对象（win），所以你只需要调用它上面的Close method即可。

但是，您不应该首先打开窗口。看看这个替代方案：

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

在Visio 2010中使用VBA关闭OpenSheetWindow

1 个答案: