将形状数据从Visio 2010传输到Excel 2010，以便使用VBA进一步操作

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

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

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

请帮忙，我一直无法find任何有关这种情况的任何信息。

先谢谢你！

Answer 1

对的，这是可能的。 这里是一些VBA代码来创build从Visio的Excel报告。 请记住，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