Excel – Transfering shape data from Visio 2010 to Excel 2010 for further manipulation using VBA

excelshapevbavisio

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.

I know how to acquire shape data and manipulate it WITHIN Visio but I'm not sure how to pass it to 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!

Best Answer

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.

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

Related Topic