VB Macro to Loop Field (Dynamic) and Export Chart (Dynamic) to Excel & Name Sheets by Field Value

    This is an updated version of http://community.qlik.com/docs/DOC-3481

     

    This is a VBScript macro intended to provide extended, dynamic export-to-excel capabilities.

     

     

    Set up:

    1. Copy/Paste macro script into application and set security setting appropriately

    2. Create variable in QV app called - vfname. This will be used to control the field to loop when exporting.

    3. Create variable in QV app called - vMacroChartId. This will be used to identify the chart to export.

    4. Create button in QV app - property settings below:

         - actions > add > external > set variable > vfname > [desired field]

         - actions > add > external > set variable > vMacroChartId > [desired chart id]

         - actions > add > external > run macro > AdHocExport

     

     

    The script will loop the field provided as the value in the variable (vfname) and export to Excel the object id provided as the value in the variable (vMacroChartId) - i.e. input box object in the QV app; button action property settings.

     

    In Excel, this will result in the copied object being pasted into each sheet for each of the possible values available in the field (set by variable). In addition, the Excel worksheet will be named according to the field value set at the time of export.

     

    This has potential in various applicable contexts to add more flexibility and extend the user's abilities to administer self-service BI as compared to the standard Excel export options within QV currently.

     

     

    Below are the list of updates applied based on common issues I observed:

    Updates:

    - added function to clean and replace the field value string of invalid characters when naming sheets in Excel to prevent macro from failing

    - updated the way sheets are created to add after the last vs previous that would start reversing order at the fourth sheet addition

    - added code that will standardize the default sheets in Excel on open regardless of user settings to mitigate issues when default was set to < 3

     

    NEW UPDATES:

    - added new file (attached: qv_vbs_autoSave_delWksh_v2_customFileName.txt) that includes an updated version which will also remove excess worksheets, auto save the file to the designated location, and set the file name dynamically depending on the selections within the qlikview app.

    - thanks to surynnchin for his feedback in creating these revisions.

     

     

     

    '---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

    FUNCTION strClean (strtoclean)
    tempstr = strtoclean
    charArray = ARRAY("?", "/", "\", ":", "*", """", "<", ">", ",", "&", "#", "~", "%", "{", "}", "+", "_", ".","[","]")
    FOR EACH tmpChar in charArray
    SELECT CASE tmpChar
      CASE "&"
      changeTo = " and "
      CASE ELSE
      changeTo = ""
    END SELECT
    tempstr = REPLACE( tempstr, tmpChar, changeTo )
    NEXT
    'msgbox tempstr
    strClean = tempstr
    END FUNCTION

    '---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

    SUB AdHocExport
    confirmation = MSGBOX ("Ad hoc Excel export has been initiated." & vbCrLf & "Do you wish to continue?"& vbCrLf &"",  36, "Export Confirmation")
      IF confirmation = 7 THEN
       EXIT SUB
      END IF
    DIM xlApp
    DIM xlBook
    DIM xlSheet, xlNewSheet, intSheetCount
    DIM strSheetName
    DIM var
    DIM fname, value
    SET f = ActiveDocument.Variables("vfname")
    fname = f.GetContent.STRING
    SET v = ActiveDocument.Variables("vMacroChartId")
    var = v.GetContent.STRING
    SET xlApp = CREATEOBJECT("Excel.Application")
    xlApp.Visible = TRUE
    SET xlBook = xlApp.Workbooks.Add
    SET xlSheet = xlBook.Worksheets("Sheet1")
    ' ActiveDocument.Fields(fname).Clear
    FOR i=1 to 3
    intSheetCount = xlBook.Application.Worksheets.Count
    IF intSheetCount < 3 THEN
      SET xlNewSheet = xlApp.Application.Worksheets.Add(, xlApp.Worksheets(xlApp.Worksheets.Count))
      xlApp.Worksheets(1).SELECT
    END IF
    NEXT
    SET Doc = ActiveDocument
    SET Field = Doc.Fields(fname).GetPossibleValues
    FOR i=0 to Field.Count-1
    Doc.Fields(fname).Clear
    Doc.FIelds(fname).SELECT Field.Item(i).Text
    Doc.GetApplication.WaitForIdle
    Doc.GetSheetObject(var).CopyTableToClipBoard TRUE
    xlApp.ActiveSheet.Paste
    xlApp.Worksheets(xlApp.ActiveSheet.Index).Cells.EntireColumn.AutoFit
    xlApp.Worksheets(xlApp.ActiveSheet.Index).Cells.EntireRow.AutoFit
    ' strSheetName = Field.Item(i).Text
    value = Field.Item(i).Text
    strSheetName = strClean(value)
    xlApp.ActiveSheet.Name = strSheetName
       IF(i<Field.Count-1)THEN
        IF(i>=2)THEN
    '     xlApp.ActiveWorkbook.Worksheets.Add
         SET xlNewSheet = xlApp.Application.Worksheets.Add(, xlApp.Worksheets(xlApp.Worksheets.Count))
        END IF
        IF(i<2) THEN
         xlApp.Worksheets(xlApp.ActiveSheet.Index +1).SELECT
        END IF
       END IF
    NEXT
    Doc.Fields(fname).Clear
    MSGBOX "Ad hoc Excel export is complete!",64,"Task Completion Notification"
    END SUB

    '---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------