I use a Macro-Skript to export Data & Objects to Excel. See Below
During this i have problems on some computers.
Everything works fine until it reach line 71.
When this line is reached the script stopps and nothing else happens. It doesn't matter how long I will wait.
This problem appears only on a few computers in my company and not on everyone.
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
Set objExcelDoc = objExcelApp.Workbooks.Add ("\\ebm\dba\edm\vorlagen\carlo.xlsm")
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)
MsgBox "Starte Übertragung Object " + qvObjectId
MsgBox "Erstelle Sheet " + sheetName
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
MsgBox "Sheet erstellt " + sheetName
objExcelSheet.Select
MsgBox "GetSheetObject " + qvObjectId
set objSource = qvDoc.GetSheetObject(qvObjectId)
Call objSource.GetSheet().Activate()
'objSource.Maximize
MsgBox "qvDoc.GetApplication.WaitForIdle start"
qvDoc.GetApplication.WaitForIdle
MsgBox "qvDoc.GetApplication.WaitForIdle ende"
if (not objSource is nothing) then
MsgBox "PasteMode " + pasteMode
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
MsgBox "Beende Übertragung Object " + qvObjectId
next
Call Excel_DeleteBlankSheets(objExcelDoc)
'// Finally select the first sheet
objExcelDoc.Sheets(1).Select
objExcelApp.run "CARLO_Export"
'// Return value
Set copyObjectsToExcelSheet = objExcelDoc
end function
