2

我正在尝试获取形状数据（具有特定形状）并将它们的值传输到 Excel 电子表格中，以便 Excel 可以对传输的值运行函数。该计划是单击一个形状并自动将其特定的形状数据发送到 Excel，在那里它将被进一步操作以创建一个非常特定的电子表格。我正在使用 VBA 进行所有编程。

我知道如何获取形状数据并在 Visio 中对其进行操作，但我不确定如何将其传递给 Excel。

那么，这甚至可能吗？我知道您可以将形状链接到数据（我已经完成）并将形状超链接到特定文档（我也完成了），但是是否可以将特定形状数据发送到文档以进行进一步操作？

请帮忙，我无法在任何地方找到有关这种情况的任何信息。

先感谢您！

4

1 回答 1

3

对的，这是可能的。这是一些从 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

于 2013-07-10T13:05:21.080 回答