Question

我正在尝试在Visio中创建一个可以读取形状的数据和属性的VB宏。所以说我在Visio中有一个带有单元格名称，描述，类型，大小等的矩形Shpae。等等。

当我尝试读取细胞及其值时，我只得到第一个细胞及其值。这是我的代码。我很感激这里的一些帮助。

    Sub Testing()

    Dim excelObj As Object
    Dim excelFile As String
    Dim sheetName As String
   ' Dim excelBook As Excel.Workbook

   ' Set excelFile = "C:\Users\hbhasin\Documents\test.xls"
    'Set sheetName = "New Sheet name"

    Set excelObj = CreateObject("Excel.Application")
    excelObj.Workbooks.Add

    Dim pagObj As Visio.Page
    Dim shpsObj As Visio.shapes
    Dim shapes As Visio.shapes
    Dim shpObj As Visio.Shape
    Dim CellObj As Visio.Cell


    Dim Storage() As String
    Dim iShapeCount As Integer
    Dim i As Integer
    Dim j As Integer



    Set pagObj = ActivePage
    Set shpsObj = pagObj.shapes
    iShapeCount = shpsObj.Count
    Debug.Print iShapeCount



   ReDim Storage(8, iShapeCount - 1)

    For i = 1 To iShapeCount - 1
        Set shpObj = shpsObj(i)
        Storage(1, i - 1) = shpObj.Name
        If shpObj.CellExists("Prop.Name", visExistsLocally) Then
            Set CellObj = shpObj.CellsU("Prop.Name")
            Storage(2, i - 1) = CellObj.ResultStr("")
        End If
        If shpObj.CellExists("Prop.Description", visExistsLocally) Then
            Debug.Print "Test the IF statement"
            Set CellObj = shpObj.CellsU("Prop.Description")
            Storage(3, i - 1) = CellObj.ResultStr("")
        End If


    Next


    For i = 0 To iShapeCount - 1
        Debug.Print "Name- " & Storage(0, i)
        Debug.Print "Description-" & Storage(1, i)



    Next







  End Sub

实际上，我已经在第二个if子句中放置了一个调试语句，并且没有执行，这告诉我编译器甚至没有看到第二个单元格或之后的任何单元格。

Answer 1

如果您没有获得描述形状数据，它可能不是本地的，而是从其主控继承。这是对您的代码的轻微修改（删除了Excel部分，因为我不认为它与此相关）：

Sub Testing()

Dim shpsObj As Visio.shapes
Set shpsObj = ActivePage.shapes

Dim iShapeCount As Integer
iShapeCount = shpsObj.Count

'Assumes you want an array of shape data
Dim Storage() As String
ReDim Storage(iShapeCount - 1, 2)

'Visio shapes are 1 based so use full count
Dim i As Integer
Dim shpObj As Visio.Shape
For i = 1 To iShapeCount
    Set shpObj = shpsObj(i)

    Storage(i - 1, 0) = shpObj.Name 'Do you want NameU?

    'Assumes you don't care whether the cell is local or inherited
    If shpObj.CellExistsU("Prop.Name", visExistsAnywhere) Then
        Storage(i - 1, 1) = shpObj.CellsU("Prop.Name").ResultStr("")
    End If

    If shpObj.CellExistsU("Prop.Description", visExistsAnywhere) Then
        Storage(i - 1, 2) = shpObj.CellsU("Prop.Description").ResultStr("")
    End If
Next

Dim j As Long
For j = LBound(Storage, 1) To UBound(Storage, 1)
    Debug.Print "Shape Name- " & Storage(j, 0)
    Debug.Print "  Prop.Name- " & Storage(j, 1)
    Debug.Print "  Prop.Description- " & Storage(j, 2)
Next j

End Sub

如果您只是浏览页面上的所有形状，那么您可能希望查看For Each shp In形状作为替代方案。查看此页面了解更多详情：

http://visualsignals.typepad.co.uk/vislog/2007/11/looping-through.html

另外，如果您要处理大量数据，您可能需要尝试查看CreateSelection page method以缩小目标形状

使用vb在Visio中读取单元属性

1 个答案: