将形状数据从 Visio 2010 传输到 Excel 2010 以使用 VBA 进行进一步操作
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/17554466/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Transfering shape data from Visio 2010 to Excel 2010 for further manipulation using VBA
提问by user2565514
I'm attempting to take shape data (withing specific shapes) and transfer their values into an Excel spreadsheet so that Excel can run functions on the transferred values. The plan is to click on a shape and automatically send its specific shape data to Excel, where it will be manipulated further to create a very specific spreadsheet. I'm using VBA for all the programming.
我正在尝试获取形状数据（具有特定形状）并将它们的值传输到 Excel 电子表格中，以便 Excel 可以对传输的值运行函数。计划是单击一个形状并自动将其特定的形状数据发送到 Excel，在 Excel 中将对其进行进一步操作以创建一个非常具体的电子表格。我正在使用 VBA 进行所有编程。
I know how to acquire shape data and manipulate it WITHIN Visio but I'm not sure how to pass it to Excel.
我知道如何获取形状数据并在 Visio 中对其进行操作，但我不确定如何将其传递给 Excel。
So, is this even possible? I know you can link shapes to data (which I've done) and hyperlink shapes to specific documents (which I've also done) but is it possible to send specific shape data to a document for further manipulation?
那么，这甚至可能吗？我知道您可以将形状链接到数据（我已经完成）并将形状超链接到特定文档（我也做过），但是是否可以将特定形状数据发送到文档以进行进一步操作？
Please help, I've not been able to find any information on this situation anywhere.
请帮助，我无法在任何地方找到有关这种情况的任何信息。
Thank you in advance!
先感谢您！
回答by John Visio MVP
Yes it is possible. Here is some VBA code to create an Excel report from Visio. Just remember that Excel VBA and Visio VBA have properties with the same name so make sure you fully qualify the Excel reference. Otherwise VBA gets confused.
对的，这是可能的。下面是一些用于从 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
John... Visio MVP
约翰... Visio MVP
