Transfering形狀數據從Visio 2010到Excel 2010用於使用VBA

我試圖採取形狀數據（withing特定形狀）和它們的值傳送到Excel電子表格以便Excel可以運行在所傳送的值的函數進一步操縱。的計劃是點擊一個形狀，自動將其具體形狀數據發送到Excel，它將被進一步操縱，以創建一個非常特定的電子表格。我使用VBA進行所有編程。Transfering形狀數據從Visio 2010到Excel 2010用於使用VBA

我知道如何獲得形狀數據，並操縱它在Visio，但我不知道如何將它傳遞到Excel中。

那麼，這甚至可能嗎？我知道你可以將形狀鏈接到數據（我已經完成）並將形狀鏈接到特定文檔（我也已經完成），但可以將特定形狀數據發送到文檔以進一步操作嗎？

請幫幫忙，我沒能在任何地方找到這種情況的任何信息。

預先感謝您！

來源

2013-07-09 user2565514

是的，它是可能的。以下是一些VBA代碼，用於從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

來源

2013-07-10 13:05:21

Transfering形狀數據從Visio 2010到Excel 2010用於使用VBA

回答

相關問題