Skip to content

Instantly share code, notes, and snippets.

@poom

poom/qlikview-data-extract-excel-pinnuwat.vbs

Last active August 29, 2015 14:09
Show Gist options
  • Save poom/d61c3790241745e7e491 to your computer and use it in GitHub Desktop.
Save poom/d61c3790241745e7e491 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
qlikview-data-extract-excel-pinnuwat.vbs
sub docTest
set HotelList = ActiveDocument.Variables("LB276")
set Montyly = ActiveDocument.Variables("LB277")
HotelList.SetContent "Asoke" , true
'Montyly.SetContent "January" , true
'MsgBox getVariable("LB276")
end sub
function getVariable(varName)
set v = ActiveDocument.Variables(varName)
getVariable = v.GetContent.String
end function
sub setVariable(varName, varValue)
set v = ActiveDocument.Variables(varName)
v.SetContent varValue, true
end sub
sub pinawatJobs
hotels = Array("Angeles City","Aseana City","Asoke","Bekasi","Cagayan De Oro")
months = Array("January","February","March","April","May","June","July","August","September","October","November","December")
hotels = Array("Angeles City","Aseana City")
months = Array("September","October")
Dim objExcelApp 'as Excel.Application
Set objExcelApp = CreateObject("Excel.Application")
objExcelApp.Visible = true 'false if you want to hide Excel
objExcelApp.DisplayAlerts = false
Dim objExcelDoc 'as Excel.Workbook
Set objExcelDoc = objExcelApp.Workbooks.Add
For Each hotel In hotels
For Each currentMonth In months
Set objExcelWorkbookTmp = exportToExcel(objExcelApp, objExcelDoc, hotel & "_" & "_" & currentMonth)
'msgbox "Hotel:" & Hotel & " Month:" & currentMonth
Next
Next
end sub
'// ****************************************************************
'// Simple Export of just one object
'// ****************************************************************
private Function exportToExcel(ByRef objExcelApp,ByRef objExcelDoc, sheetName)
'//Array for export definitions
Dim aryExport(13,3)
'//sheetName = "Test Export"
'//Name of QV object to export data from
'//Name of the worksheet in Excel
'//Cell to start export
'//Export format - data/image/etc
'// Local Currency
aryExport(0,0) = "CH454"
aryExport(0,1) = sheetName
aryExport(0,2) = "A1"
aryExport(0,3) = "data"
'// Revenue
aryExport(1,0) = "CH453"
aryExport(1,1) = sheetName
aryExport(1,2) = "A15"
aryExport(1,3) = "data"
'//Departmental Expense
aryExport(2,0) = "CH453"
aryExport(2,1) = sheetName
aryExport(2,2) = "A30"
aryExport(2,3) = "data"
'//Departmental Income
aryExport(3,0) = "CH456"
aryExport(3,1) = sheetName
aryExport(3,2) = "A45"
aryExport(3,3) = "data"
'//Unallocated Expense
aryExport(4,0) = "CH460"
aryExport(4,1) = sheetName
aryExport(4,2) = "A60"
aryExport(4,3) = "data"
'//Gross Operating Profit
aryExport(5,0) = "CH459"
aryExport(5,1) = sheetName
aryExport(5,2) = "A75"
aryExport(5,3) = "data"
'//Fixed Expenses
aryExport(6,0) = "CH458"
aryExport(6,1) = sheetName
aryExport(6,2) = "A90"
aryExport(6,3) = "data"
'//EBITDA
aryExport(7,0) = "CH457"
aryExport(7,1) = sheetName
aryExport(7,2) = "A105"
aryExport(7,3) = "data"
'//Bank Loan Interest
aryExport(8,0) = "CH461"
aryExport(8,1) = sheetName
aryExport(8,2) = "A120"
aryExport(8,3) = "data"
'//Operating Profit
aryExport(9,0) = "CH464"
aryExport(9,1) = sheetName
aryExport(9,2) = "A135"
aryExport(9,3) = "data"
'//Unallocated Expense
aryExport(10,0) = "CH462"
aryExport(10,1) = sheetName
aryExport(10,2) = "A150"
aryExport(10,3) = "data"
'//Unallocated Expense
aryExport(11,0) = "CH479"
aryExport(11,1) = sheetName
aryExport(11,2) = "A165"
aryExport(11,3) = "data"
'//Unallocated Expense
aryExport(12,0) = "CH480"
aryExport(12,1) = sheetName
aryExport(12,2) = "A180"
aryExport(12,3) = "data"
'//Unallocated Expense
aryExport(13,0) = "CH463"
aryExport(13,1) = sheetName
aryExport(13,2) = "A195"
aryExport(13,3) = "data"
Dim objExcelWorkbook 'as Excel.Workbook
Set objExcelWorkbook = copyObjectsToExcelSheet(ActiveDocument, aryExport,objExcelApp, objExcelDoc)
Set exportToExcel = objExcelWorkbook
end function
'// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'// 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, ByRef objExcelApp, ByRef objExcelDoc) 'as Excel.Workbook
Dim i 'as Integer
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 = 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
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 ...
'// ****************************************************************
Private 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
'//__________________________________________________________________
Raw
qlikview-data-extract-excel.vbs
'// ****************************************************************
'// 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(4,3)
aryExport(0,0) = "objSalesPerRegion"
aryExport(0,1) = "Sales Overview"
aryExport(0,2) = "A1"
aryExport(0,3) = "image"
aryExport(1,0) = "objTopCustomers"
aryExport(1,1) = "Sales Overview"
aryExport(1,2) = "H1"
aryExport(1,3) = "image"
aryExport(2,0) = "objSalesPerYearAndRegion"
aryExport(2,1) = "Sales Overview"
aryExport(2,2) = "A14"
aryExport(2,3) = "data"
aryExport(3,0) = "objTopCustomers"
aryExport(3,1) = "Top Customers"
aryExport(3,2) = "A1"
aryExport(3,3) = "image"
aryExport(4,0) = "objTopCustomers"
aryExport(4,1) = "Top Customers"
aryExport(4,2) = "A14"
aryExport(4,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
'// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'// 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
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 = 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
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
'//__________________________________________________________________
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment