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:
- 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
- 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.
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