Hi, I have this simple code running from Visio which falls over at line 10 with subscript out of range. I want Visio to read the excel file and add shapes with text to a drawing but I can't even access the excel workbook. I believe I have the necessary References ticked. Any suggestions? Thanks in advance.
Option Explicit
Public Sub Export_Shape_Data()
Dim shp As Visio.Shape
Dim AppExcel As Object 'Excel.Application
Dim wkbook As Excel.Workbook
Dim wkbooksheet As Object 'Excel.Worksheet
Dim i As Integer
Dim shpname As String
Dim a As String
Set AppExcel = CreateObject("Excel.Application")
10 Set wkbook = AppExcel.Workbooks("SampleWB.xlsx")
Set wkbooksheet = wkbook.worksheets("Sheet2")
wkbook.Sheets("Sheet2").Select
End Sub
The only thing I see, line 10 doesn't know where to find the file. You have to established its location. See http://visguy.com/vgforum/index.php?topic=7450.0 (http://visguy.com/vgforum/index.php?topic=7450.0) as example.
Wapperdude
Use:
...GetObject(, "Excel.Application")
...Workbooks("SampleWB.xlsx")
or
...CreateObject("Excel.Application")
...Workbooks.Add("[full path]\SampleWB.xlsx")
Thanks, what I would like to do is read an already open Excel file so that I can run the Visio macro, make some changes to the Excel file and re-run the Visio macro. The question then is how to "tell" the macro that the file is already open.
Try to get existing objects and check errors. If error, then create objects.
Approximately like this:
On Error Resume Next
Set AppExcel = GetObject(, "Excel.Application")
If Not AppExcel Is Nothing Then
Set wkbook = AppExcel.Workbooks("SampleWB.xlsx")
If Not wkbook Is Nothing Then
'All OK. File is already open
Else
'Application exists, but you need to open file
Set wkbook = AppExcel.Workbooks.Add("[full path]\SampleWB.xlsx")
End If
Else
'need create application
Set AppExcel = CreateObject("Excel.Application")
'and open file
Set wkbook = AppExcel.Workbooks.Add("[full path]\SampleWB.xlsx")
End If
On Error GoTo 0
No joy, I'm afraid. Removing the On Error line, gives a subscript out of range error at the "Set wkbook = AppExcel.Workbooks("SampleWB.xlsx")" line. The excel file is already open but Visio isn't able to see that it is. Any suggestions?
Perhaps you have created several instances of Excel.Application.
Each instance contains its own set of Workbooks.
It's like your situation.
Restart the operating system and try my code again.
See this topic for working with multiple instances of Excel
https://stackoverflow.com/questions/30363748/having-multiple-excel-instances-launched-how-can-i-get-the-application-object-f
The following code (Sub Test) shows all Excel instances and workbooks in them.
#If VBA7 Then
Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" ( _
ByVal hwnd As LongPtr, ByVal dwId As Long, riid As Any, ppvObject As Object) As Long
Private Declare PtrSafe Function FindWindowExA Lib "user32" ( _
ByVal hwndParent As LongPtr, ByVal hwndChildAfter As LongPtr, _
ByVal lpszClass As String, ByVal lpszWindow As String) As LongPtr
#Else
Private Declare Function AccessibleObjectFromWindow Lib "oleacc" ( _
ByVal hwnd As Long, ByVal dwId As Long, riid As Any, ppvObject As Object) As Long
Private Declare Function FindWindowExA Lib "user32" ( _
ByVal hwndParent As Long, ByVal hwndChildAfter As Long, _
ByVal lpszClass As String, ByVal lpszWindow As String) As Long
#End If
Sub Test()
Set c = GetExcelInstances()
'For Each xl In GetExcelInstances()
Dim cc As Collection
Set cc = New Collection
On Error Resume Next
For j = 1 To c.Count
cc.Add c(j), CStr(c(j).hwnd)
Next
On Error GoTo 0
For j = 1 To cc.Count
Debug.Print "hwnd: " & cc(j).hwnd
For i = 1 To cc(j).Workbooks.Count
Debug.Print "-----> " & cc(j).Workbooks(i).Name
Next
Next
End Sub
Public Function GetExcelInstances() As Collection
Dim guid&(0 To 3), acc As Object, hwnd, hwnd2, hwnd3
guid(0) = &H20400
guid(1) = &H0
guid(2) = &HC0
guid(3) = &H46000000
Set GetExcelInstances = New Collection
Do
hwnd = FindWindowExA(0, hwnd, "XLMAIN", vbNullString)
If hwnd = 0 Then Exit Do
hwnd2 = FindWindowExA(hwnd, 0, "XLDESK", vbNullString)
hwnd3 = FindWindowExA(hwnd2, 0, "EXCEL7", vbNullString)
If AccessibleObjectFromWindow(hwnd3, &HFFFFFFF0, guid(0), acc) = 0 Then
GetExcelInstances.Add acc.Application
End If
Loop
End Function
Example output
hwnd: 131894
-----> Copy of task19.xls
-----> bpmn.xlsx
hwnd: 131804
-----> test2.xlsx
Without the error checking, and it assumes that the Excel file exists, it doesn't have to be open, but can be, this code will just open it again. I ran it 3 successive times, ended with three windows of the same file. Make sure you have all of the references set for use.
Sub OpenXcl()
' The following references are used:
' Visual Basic for Applications
' Microsoft Visio Type Library
' OLE Automation
' Microsoft Office Object Library
' Microsoft Excel Object Library
' You'll have to choose the appropriate versions based upon your installation
'
Dim XlApp As Object
Dim XlWrkbook As Excel.Workbook
Dim XlSheet As Excel.Worksheet
Set XlApp = CreateObject("Excel.Application")
XlApp.Workbooks.Open "H:\YourDir\Sch Netlist Test.xlsx" 'NOTE: Replace the path and the filename to actual path and name.
Set XlWrkbook = XlApp.Workbooks(1)
Set XlSheet = XlWrkbook.Worksheets("Sheet1")
XlApp.Visible = True
End Sub
You can connect your Visio drawing to the Excel data using data binding functionality (look at the "Data" tab!)
You don't have to do it programmatically, i.e. you don't need any code. It is much easier.
For exporting data to Excel, you have shape reports button.
If you want Visio to build a diagram from excel data, you could use new data visualizer.
https://support.office.com/en-us/article/create-a-data-visualizer-diagram-17211b46-d144-4ca2-9ea7-b0f48f0ae0a6