Macro VB Script Error

Anonymous — Tue, 30 Jan 2018 10:10:19 GMT

Hi,

I am trying to modify the following macro (the macro itself has more aryExports) of Qlikview but I get the following error.

In QV12 it works correctly, but in 11.2 it doesn't work.

It is not the typical security error as System Access is allowed.

It seems it has something to do with the macro, is there any bug developing VB macros in 11,2? any line break incompatibility?

sub exportToExcel_Variant2

'// Array for export definitions

Dim aryExport(1,3)

aryExport(0,0) = "TX1468"

aryExport(0,1) = "Summary"

aryExport(0,2) = "B2"

aryExport(0,3) = "image"

aryExport(1,0) = "TX1472"

aryExport(1,1) = "Summary"

aryExport(1,2) = "D2"

aryExport(1,3) = "image"

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

Set objExcelDoc = objExcelApp.Workbooks.Add

'msgbox "Hola"

objExcelApp.DisplayFormulaBar = False

objExcelApp.ActiveWindow.DisplayGridlines = False

objExcelApp.ActiveWindow.DisplayHeadings = False

'msgbox "Hola"

Dim strSourceObject

Dim qvObjectId 'as String

Dim sheetName

Dim sheetRange

Dim pasteMode

Dim objSource

Dim objCurrentSheet

Dim objExcelSheet

'msgbox UBOUND(aryExportDefinition)

for i = 0 to UBOUND(aryExportDefinition)

' msgbox "i: " & i

'// 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

objExcelSheet.Select

set objSource = qvDoc.GetSheetObject(qvObjectId)

Call objSource.GetSheet().Activate()

objSource.Maximize

qvDoc.GetApplication.WaitForIdle 500

if (not objSource is nothing) then

if (pasteMode = "image") then

Call objSource.CopyBitmapToClipboard()

' msgbox "Imagen"

else

if (pasteMode = "text") then

Call objSource.CopyTextToClipboard

' msgbox "Texto"

else

Call objSource.CopyTableToClipboard(true) '// default & fallback

' msgbox "Tabla"

end if

' msgbox "11111"

Set objCurrentSheet = objExcelDoc.Sheets(sheetName)

objExcelDoc.Sheets(sheetName).Range(sheetRange).Select

objExcelDoc.Sheets(sheetName).Paste

' msgbox "22222"

' objExcelDoc.Cells.Select

if (pasteMode <> "image") then

With objExcelApp.Selection

.WrapText = False

.ShrinkToFit = False

if (pasteMode = "text") and (i =31 or i =34 or i =37 or i =40) then

' .Columns.AutoFit

.Font.Bold = True

end if

End With

end if

' msgbox "3333"

objCurrentSheet.Range("A1").Select

end if

objSource.Restore

'msgbox "Salir"

Call Excel_DeleteBlankSheets(objExcelDoc)

'// Finally select the first sheet

objExcelDoc.Sheets(1).Select

'// Return value

Set copyObjectsToExcelSheet = objExcelDoc

'set objSource = qvDoc.GetSheetObject(SH_RR)

'Call objSource.GetSheet().Activate()

qvDoc.Sheets("SH_RR").Activate

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

'// 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 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

'//__________________________________________________________________

topic Macro VB Script Error in QlikView

Macro VB Script Error

Re: Macro VB Script Error

Re: Macro VB Script Error