Перенос данных формы из Visio 2010 в Excel 2010 для дальнейших манипуляций с использованием VBA

Question

Я пытаюсь получить данные формы (с определенными формами) и перенести их значения в электронную таблицу Excel, чтобы Excel мог запускать функции переданных значений. План состоит в том, чтобы щелкнуть по фигуре и автоматически отправить свои данные конкретной формы в Excel, где далее будет обрабатываться конкретная электронная таблица. Я использую VBA для программирования.

Я знаю, как получить данные о форме и управлять им WITHIN Visio, но я не уверен, как передать его в Excel.

Итак, возможно ли это? Я знаю, что вы можете связать фигуры с данными (которые я сделал) и гиперссылки к конкретным документам (что я также сделал), но можно ли отправить конкретные данные формы в документ для дальнейших манипуляций?

Просьба помочь, я не смог найти информацию об этой ситуации в любом месте.

Спасибо заранее!

Answer 1

Да, это возможно. Вот несколько кодов VBA для создания отчета Excel из Visio. Просто помните, что 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 

Джон ... Визио MVP