Skip to main content
Announcements
Have questions about Qlik Connect? Join us live on April 10th, at 11 AM ET: SIGN UP NOW
cancel
Showing results for 
Search instead for 
Did you mean: 
Not applicable

Exporting multiple objects to multiple Excel sheets

I tried to implement the code from qlikblog_ExportToMultipleExcelSheets.qvw; and couldn't get it to run. I wound up putting in 14 msgbox commands along the entire code until I could get it working by process of elimination. I was able to get it down to where msgbox "2" was. When I run the macro, it works perfectly if I leave msgbox "2" in the code, and press OK when the box comes up. But when I comment out msgbox "2", the code breaks and the macro fails. It just stops and opens the module window.

Can anyone see a reason why this would be occurring where the msgbox command is? Unfortunately due to confidentiality of data, I cannot attach the file.

sub exportToExcel_Variant2

'// Array for export definitions
Dim aryExport(5,3)


aryExport(0,0) = "objRanking"
aryExport(0,1) = "Ranking-Screening"
aryExport(0,2) = "A1"
aryExport(0,3) = "data"

aryExport(1,0) = "objNomem"
aryExport(1,1) = "Nomem"
aryExport(1,2) = "A1"
aryExport(1,3) = "data"

aryExport(2,0) = "objNotif"
aryExport(2,1) = "M6 Notification"
aryExport(2,2) = "A1"
aryExport(2,3) = "data"

aryExport(3,0) = "objFAD"
aryExport(3,1) = "FAD"
aryExport(3,2) = "A1"
aryExport(3,3) = "data"

aryExport(4,0) = "objRun"
aryExport(4,1) = "Run History"
aryExport(4,2) = "A1"
aryExport(4,3) = "data"

aryExport(5,0) = "objZJAM"
aryExport(5,1) = "ZJAM"
aryExport(5,2) = "A1"
aryExport(5,3) = "data"

Dim objExcelWorkbook 'as Excel.Workbook
Set objExcelWorkbook = copyObjectsToExcelSheet(ActiveDocument, aryExport)


'// Now either just leave Excel open or do some other stuff here
'// like saving the excel, some formatting stuff, ...

end sub



Private Function copyObjectsToExcelSheet(qvDoc, aryExportDefinition) 'as Excel.Workbook


Dim i 'as Integer
Dim objExcelApp 'as Excel.Application
Dim objExcelDoc 'as Excel.Workbook

Set objExcelApp = CreateObject("Excel.Application")

objExcelApp.Visible = true 'false if you want to hide Excel
objExcelApp.DisplayAlerts = false

msgbox "2"


Set objExcelDoc = objExcelApp.Workbooks.Add

Dim strSourceObject

Dim qvObjectId 'as String
Dim sheetName
Dim sheetRange
Dim pasteMode
Dim objSource
Dim objCurrentSheet
Dim objExcelSheet


for i = 0 to UBOUND(aryExportDefinition)

'// Get the properties of the exportDefinition array
qvObjectId = aryExportDefinition(i,0)
sheetName = aryExportDefinition(i,1)
sheetRange = aryExportDefinition(i,2)
pasteMode = aryExportDefinition(i,3)

Set objExcelSheet = Excel_GetSheetByName(objExcelDoc, sheetName)
if (objExcelSheet is nothing) then
Set objExcelSheet = Excel_AddSheet(objExcelApp, sheetName)
if (objExcelSheet is nothing) then
msgbox("No sheet could be created, this should not occur!!!")
end if
end if

objExcelSheet.Select 

set objSource = qvDoc.GetSheetObject(qvObjectId)
Call objSource.GetSheet().Activate()
objSource.Maximize
qvDoc.GetApplication.WaitForIdle


if (not objSource is nothing) then

if (pasteMode = "image") then
Call objSource.CopyBitmapToClipboard()
else
Call objSource.CopyTableToClipboard(true) '// default & fallback
end if

Set objCurrentSheet = objExcelDoc.Sheets(sheetName)
objExcelDoc.Sheets(sheetName).Range(sheetRange).Select
objExcelDoc.Sheets(sheetName).Paste

if (pasteMode <> "image") then
With objExcelApp.Selection
.WrapText = False
.ShrinkToFit = False
End With 
end if 

objCurrentSheet.Range("A1").Select 
end if


next



Call Excel_DeleteBlankSheets(objExcelDoc)

'// Finally select the first sheet
objExcelDoc.Sheets(1).Select

'// Return value
Set copyObjectsToExcelSheet = objExcelDoc

end function
'// ________________________________________________________________


'// ****************************************************************
'// Internal function for getting the Excel sheet by sheetName
'// ****************************************************************
Private Function Excel_GetSheetByName(ByRef objExcelDoc, sheetName) 'as Excel.Sheet

For Each ws In objExcelDoc.Worksheets
If (trim(ws.Name) = Excel_GetSafeSheetName(sheetName)) then
Set Excel_GetSheetByName = ws
exit function
End If
Next

'// default return value
Set Excel_GetSheetByName = nothing

End Function
'// ________________________________________________________________


Private Function Excel_GetSafeSheetName(sheetName)

'// can be max 31 characters long
retVal = trim(left(sheetName, 31))

Excel_GetSafeSheetName = retVal
End Function



'// ****************************************************************
'// Internal function for adding a new sheet
'// ****************************************************************
Private Function Excel_AddSheet(objExcelApplication, sheetName) ' as Excel.Sheet

'// add a sheet to the last position
objExcelApplication.Sheets.Add , objExcelApplication.Sheets(objExcelApplication.Sheets.Count)

Dim objNewSheet
Set objNewSheet = objExcelApplication.Sheets(objExcelApplication.Sheets.Count)
objNewSheet.Name = left(sheetName,31)

'// return the newly created sheet
Set Excel_AddSheet = objNewSheet

End function
'// ________________________________________________________________



'// ****************************************************************
'// Delete all empty sheets
'// ****************************************************************
Private Sub Excel_DeleteBlankSheets(ByRef objExcelDoc)

For Each ws In objExcelDoc.Worksheets
If (not HasOtherObjects(ws)) then
If objExcelDoc.Application.WorksheetFunction.CountA(ws.Cells) = 0 Then
On Error Resume Next
Call ws.Delete()
End If
End If
Next


End Sub
'// ________________________________________________________________



'// ****************************************************************
'// Helper function to determine if there are other objects placed
'// on the sheet ...
'// ****************************************************************
Public Function HasOtherObjects(ByRef objSheet) 'As Boolean
Dim c
If (objSheet.ChartObjects.Count > 0) Then
HasOtherObjects = true
Exit function
End If
If (objSheet.Pictures.Count > 0) Then
HasOtherObjects = true
Exit function
End If
If (objSheet.Shapes.Count > 0) Then
HasOtherObjects = true
Exit function
End If


HasOtherObjects = false
End Function
'//__________________________________________________________________



1 Solution

Accepted Solutions
m_woolf
Master II
Master II

You might look in the task manager to see if you have multiple instances of Excel open. If so, end those processes.

When you run the code up to msgbox "2" , you should have an open instance of Excel with no open workbook.

You should try to debug just this code snippet:

sub test

     Set objExcelApp = CreateObject("Excel.Application")

     objExcelApp.Visible = true 'false if you want to hide Excel

     objExcelApp.DisplayAlerts = false

     Set objExcelDoc = objExcelApp.Workbooks.Add

end sub

View solution in original post

8 Replies
m_woolf
Master II
Master II

You should continue to add msgboxs until you can identify the exact line where the macro fails.

Not applicable
Author

Thanks, I already did that. I had 14, this is the only one left. This is where it fails.

m_woolf
Master II
Master II

So you are saying that:

Set objExcelDoc = objExcelApp.Workbooks.Add

is the line that fails?


This code works fine for me:

sub test

     Set objExcelApp = CreateObject("Excel.Application")

     objExcelApp.Visible = true 'false if you want to hide Excel

     objExcelApp.DisplayAlerts = false

     Set objExcelDoc = objExcelApp.Workbooks.Add

end sub

Not applicable
Author

I guess I'm really not sure then. If I put another msgbox after it and comment out msgbox 2, then it fails. I'm at a loss how else to troubleshoot.

m_woolf
Master II
Master II

When you run the code and it fails, do you have an instance of Excel that was opened by the code?

Not applicable
Author

It appears that when I comment out the msgbox and run it, the screen flickers like it was trying to open Excel, then the module window opens and the code stops running.

m_woolf
Master II
Master II

You might look in the task manager to see if you have multiple instances of Excel open. If so, end those processes.

When you run the code up to msgbox "2" , you should have an open instance of Excel with no open workbook.

You should try to debug just this code snippet:

sub test

     Set objExcelApp = CreateObject("Excel.Application")

     objExcelApp.Visible = true 'false if you want to hide Excel

     objExcelApp.DisplayAlerts = false

     Set objExcelDoc = objExcelApp.Workbooks.Add

end sub

Not applicable
Author

Thank you. I had tried something yesterday because I felt that if the code ran when the msgbox was there, then it should run without. I wondered if there was a timing issue. So I scripted in this delay and it runs perfectly now. Thanks again for helping me pin-point the code snipet. This is was what finally worked.

sub test

Set objExcelApp = CreateObject("Excel.Application")
  objExcelApp.Visible = true 'false if you want to hide Excel
  objExcelApp.DisplayAlerts = false

Dim dteWait
dteWait = DateAdd("s", 2, Now())
Do Until (Now() > dteWait)
Loop

Set objExcelDoc = objExcelApp.Workbooks.Add

end sub