Vba 使用vb读取Visio中的单元格属性
我正在尝试在Visio中创建一个VB宏，它可以读取形状的数据和属性。假设我在Visio中有一个矩形Shpae，其中包含单元格名称、描述、类型、大小。。。。等等 当我试图读取单元格及其值时，我只得到第一个单元格及其值。 这是我的密码。我希望能在这里得到一些帮助Vba 使用vb读取Visio中的单元格属性,vba,visio,Vba,Visio,我正在尝试在Visio中创建一个VB宏，它可以读取形状的数据和属性。假设我在Visio中有一个矩形Shpae，其中包含单元格名称、描述、类型、大小。。。。等等 当我试图读取单元格及其值时，我只得到第一个单元格及其值。 这是我的密码。我希望能在这里得到一些帮助 Sub Testing() Dim excelObj As Object Dim excelFile As String Dim sheetName As String ' Dim excelBook
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子句中放了一条debug语句，它没有执行，这告诉我编译器甚至没有看到第二个单元格或后面的任何单元格。如果没有得到描述形状数据，它可能不是本地的，而是从其主单元格继承的。以下是对您的代码的一个轻微修改，删除了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