对的,这是可能的。这是一些从 Visio 创建 Excel 报表的 VBA 代码。请记住,Excel VBA 和 Visio VBA 具有同名的属性,因此请确保您完全限定 Excel 引用。否则 VBA 会感到困惑。
Public Sub ExcelReport()
Dim shpsObj As Visio.Shapes, shpObj As Visio.Shape
Dim celObj1 As Visio.Cell, celObj2 As Visio.Cell
Dim curShapeIndx As Integer
Dim localCentx As Double, localCenty As Double, localCenty1 As Double
Dim ShapesCnt As Integer, i As Integer
Dim ShapeHeight As Visio.Cell, ShapeWidth As Visio.Cell
Dim XlApp As Excel.Application
Dim XlWrkbook As Excel.Workbook
Dim XlSheet As Excel.Worksheet
Set XlApp = CreateObject("excel.application")
' You may have to set Visible property to True if you want to see the application.
XlApp.Visible = True
Set XlWrkbook = XlApp.Workbooks.Add
Set XlSheet = XlWrkbook.Worksheets("sheet1")
Set shpObjs = ActivePage.Shapes
ShapesCnt = shpObjs.Count
XlSheet.Cells(1, 1) = "Indx"
XlSheet.Cells(1, 2) = "Name"
XlSheet.Cells(1, 3) = "Text"
XlSheet.Cells(1, 4) = "localCenty"
XlSheet.Cells(1, 5) = "localCentx"
XlSheet.Cells(1, 6) = "Width"
XlSheet.Cells(1, 7) = "Height"
' Loop through all the shapes on the page to find their locations
For curShapeIndx = 1 To ShapesCnt
Set shpObj = shpObjs(curShapeIndx)
If Not shpObj.OneD Then
Set celObj1 = shpObj.Cells("pinx")
Set celObj2 = shpObj.Cells("piny")
localCentx = celObj1.Result("inches")
localCenty = celObj2.Result("inches")
Set ShapeWidth = shpObj.Cells("Width")
Set ShapeHeight = shpObj.Cells("Height")
Debug.Print shpObj.Name, shpObj.Text, curShapeIndx; Format(localCenty, "000.0000") & " " & Format(localCentx, "000.0000"); " "; ShapeWidth; " "; ShapeHeight
i = curShapeIndx + 1
XlSheet.Cells(i, 1) = curShapeIndx
XlSheet.Cells(i, 2) = shpObj.Name
XlSheet.Cells(i, 3) = shpObj.Text
XlSheet.Cells(i, 4) = localCenty
XlSheet.Cells(i, 5) = localCentx
XlSheet.Cells(i, 6) = ShapeWidth
XlSheet.Cells(i, 7) = ShapeHeight
End If
Next curShapeIndx
XlApp.Quit ' When you finish, use the Quit method to close
Set XlApp = Nothing '
End Sub
约翰... Visio MVP