Skip to main content
Announcements
Qlik Connect 2024! Seize endless possibilities! LEARN MORE
cancel
Showing results for 
Search instead for 
Did you mean: 
Anonymous
Not applicable

Export QV Object to Excel per Member Number

I have an Macro Script to export QV Object into an Excel file. In this macro, i tried to create multiple excel files with using dynamic loop. but it only create 1 excel file, and then the QV were freeze.. It showed never ended macro running. Is there any ways to know what problem was occured? FYI, I got this macro below from community, and try to combine some of them to meet my needs. Thankyou.

****************************************************************

''// Simple Export of just one object

''// ****************************************************************

'sub exportToExcel_Variant1

'

''// Array for export definitions

'Dim aryExport(0,3)

'

'

'aryExport(0,0) = "objSalesPerYearAndRegion"    

'aryExport(0,1) = "Sales per Region a. Year"

'aryExport(0,2) = "A1"

'aryExport(0,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

'

'

''// ****************************************************************

''// More enhanced export of three objects to three different sheets

''// ****************************************************************

'sub exportToExcel_Variant2

'

''// Array for export definitions

'Dim aryExport(2,3)

'

'

'aryExport(0,0) = "objSalesPerRegion"

'aryExport(0,1) = "Sales per Region"

'aryExport(0,2) = "A1"                

'aryExport(0,3) = "data"

'

'aryExport(1,0) = "objTopCustomers"    

'aryExport(1,1) = "Top Customers"

'aryExport(1,2) = "A1"

'aryExport(1,3) = "data"

'

'aryExport(2,0) = "objSalesPerYearAndRegion"    

'aryExport(2,1) = "Sales per Region a. Year"

'aryExport(2,2) = "A1"

'aryExport(2,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

'// ****************************************************************

'// Export of multiple objects in different formats (data & image)

'// In one case (sheet "Sales Overview") two objects are placed on

'// one sheet.

'// ****************************************************************

sub exportToExcel_Variant3

Dim aryExport(8,3)

aryExport(0,0) = "TX02"

aryExport(0,1) = "QlikView Object"

aryExport(0,2) = "A1"                

aryExport(0,3) = "image"

aryExport(1,0) = "TX09"

aryExport(1,1) = "QlikView Object"

aryExport(1,2) = "B4"                

aryExport(1,3) = "image"

aryExport(2,0) = "TX06"

aryExport(2,1) = "QlikView Object"

aryExport(2,2) = "A9"                

aryExport(2,3) = "image"

aryExport(3,0) = "TX08"

aryExport(3,1) = "QlikView Object"

aryExport(3,2) = "F9"                

aryExport(3,3) = "image"

aryExport(4,0) = "TX07"

aryExport(4,1) = "QlikView Object"

aryExport(4,2) = "A19"                

aryExport(4,3) = "image"

aryExport(5,0) = "TX14"

aryExport(5,1) = "QlikView Object"

aryExport(5,2) = "F19"                

aryExport(5,3) = "image"

aryExport(6,0) = "objCompMemberTableChart"

aryExport(6,1) = "QlikView Object"

aryExport(6,2) = "A48"                

aryExport(6,3) = "data"

aryExport(7,0) = "objCompMemberBarChart"    

aryExport(7,1) = "QlikView Object"

aryExport(7,2) = "A29"

aryExport(7,3) = "image"

aryExport(8,0) = "TX05"

aryExport(8,1) = "QlikView Object"

aryExport(8,2) = "A177"                

aryExport(8,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

'// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

'// YOU DO NOT NEED TO CHANGE THE CODE BELOW !!!!!!!!!!!!!!!!!!!!!!!

'// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

'// ****************************************************************

'// copyObjectsToExcel

'// ~~

'// Parameters:

'//        qvDoc - Reference to the QlikView document (normally just use

'//                "ActiveDocument", but you can also use copyObjectsToExcel

'//                outside of QlikView ...

'//        aryExportDefinition - array of settings

'// ~~

'// Version 1.02

'// ~~

'// The aryExportDefinition is used to pass the following properties to

'// copyObjectsToExcelSheet:

'//

'//   Index        Description

'// ------------------------

'//     0    -     Id of the QlikView object to copy from

'//     1    -     Name of the sheet (in Excel) where the object should be copied to

'//

'//                (If a sheet with the same name already exists no new

'//             sheet will be created, instead the existing sheet will

'//                be used for pasting the object)

'//

'//                Note: the sheetName can be max 31 characters long

'//

'//        2    -     Range in Excel where the object should be pasted to

'//        3    -     PasteMode ["data", "image"]

'//                Defines if the objects underlaying data should be

'//                pasted ("data") or the the image representing the object

'//                should be used

'// ****************************************************************

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

'Assign  Inv_year field to FieldName, because the report generates for each Inv_year

SET f = qvDoc.Variables("vPolicyNum")

FieldName = f.GetContent.STRING  

qvDoc.Fields(FieldName).Clear

SET Field = qvDoc.Fields(FieldName).GetPossibleValues(5)

      For i=0 to Field.Count-1

          qvDoc.Fields(FieldName).SELECT Field.Item(i).Text

          qvDoc.GetApplication.WaitForIdle

for j = 0 to UBOUND(aryExportDefinition)

    '// Get the properties of the exportDefinition array

    qvObjectId = aryExportDefinition(j,0)

    sheetName = aryExportDefinition(j,1)

    sheetRange = aryExportDefinition(j,2)

    pasteMode = aryExportDefinition(j,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

'// Save the excel workbook

objExcelDoc.SaveAs "D:\testexport\Export QV_" & Year(Now) & "-" & Month(Now) & "-" & Day(Now) & Field.Item(i).Text & ".xlsx"

objExcelApp.Quit

next

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

'//__________________________________________________________________

0 Replies