2 Replies Latest reply: Feb 26, 2016 3:25 PM by Miguel Lemoz RSS

    Macro Does Not Work in QlikView via Internet Explorer

    Игорь Слободчиков

      Good afternoon.

       

      There is a macro that allows you to load data from an Excel spreadsheet.

      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
        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 = True
        .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
      
      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
      
      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
      
      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
      
      
      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
      
      
      

      On the local computer, it works fine through Internet Explorer (version QlikView Server), one computer is working properly, an error message pops up in others:

      This is no error, if you open a document select

      Otherwise, an error occurs.

       

      How can I fix this problem.