Re: Exporting tables to excel

alexandros17 — Fri, 11 Jul 2014 12:35:10 GMT

Copy this code into your TOOLS -> Edit Module section, adapte it and let me know

sub exportToExcel_Distributor_Coverage

Dim aryExport(0,4)

aryExport(0,0) = "CH08"

aryExport(0,1) = "Distributor Coverage"

aryExport(0,2) = "A2"

aryExport(0,3) = "data"

aryExport(0,4) = "A1"

Dim objExcelWorkbook 'as Excel.Workbook

Set objExcelWorkbook = copyObjectsToExcelSheet(ActiveDocument, aryExport)

end sub

sub exportToExcel_Printing_Supplies

Dim aryExport(1,4)

aryExport(0,0) = "CH16"

aryExport(0,1) = "Printing-Supplies"

aryExport(0,2) = "A2"

aryExport(0,3) = "data"

aryExport(0,4) = "A1"

aryExport(1,0) = "CH17"

aryExport(1,1) = "Printing-Supplies"

aryExport(1,2) = "G2"

aryExport(1,3) = "image"

aryExport(1,4) = "G1"

Dim objExcelWorkbook 'as Excel.Workbook

Set objExcelWorkbook = copyObjectsToExcelSheet(ActiveDocument, aryExport)

end sub

sub exportToExcel_Printing_HW_SET_A3

Dim aryExport(1,4)

aryExport(0,0) = "CH18"

aryExport(0,1) = "Printing-HW-SET-A3"

aryExport(0,2) = "A2"

aryExport(0,3) = "data"

aryExport(0,4) = "A1"

aryExport(1,0) = "CH19"

aryExport(1,1) = "Printing-HW-SET-A3"

aryExport(1,2) = "G2"

aryExport(1,3) = "image"

aryExport(1,4) = "G1"

Dim objExcelWorkbook 'as Excel.Workbook

Set objExcelWorkbook = copyObjectsToExcelSheet(ActiveDocument, aryExport)

end sub

sub exportToExcel_Printing_HW_SET_A4

Dim aryExport(1,4)

aryExport(0,0) = "CH20"

aryExport(0,1) = "Printing-HW-SET-A4"

aryExport(0,2) = "A2"

aryExport(0,3) = "data"

aryExport(0,4) = "A1"

aryExport(1,0) = "CH21"

aryExport(1,1) = "Printing-HW-SET-A4"

aryExport(1,2) = "G2"

aryExport(1,3) = "image"

aryExport(1,4) = "G1"

Dim objExcelWorkbook 'as Excel.Workbook

Set objExcelWorkbook = copyObjectsToExcelSheet(ActiveDocument, aryExport)

end sub

sub exportToExcel_Visual_Display_LFD_MONOPT

Dim aryExport(1,4)

aryExport(0,0) = "CH22"

aryExport(0,1) = "Visual Display-LFD-MON OPT"

aryExport(0,2) = "A2"

aryExport(0,3) = "data"

aryExport(0,4) = "A1"

aryExport(1,0) = "CH23"

aryExport(1,1) = "Visual Display-LFD-MON OPT"

aryExport(1,2) = "G2"

aryExport(1,3) = "image"

aryExport(1,4) = "G1"

Dim objExcelWorkbook 'as Excel.Workbook

Set objExcelWorkbook = copyObjectsToExcelSheet(ActiveDocument, aryExport)

end sub

sub exportToExcel_Visual_Display_HotelTV

Dim aryExport(1,4)

aryExport(0,0) = "CH24"

aryExport(0,1) = "Visual Display-Hotel TV"

aryExport(0,2) = "A2"

aryExport(0,3) = "data"

aryExport(0,4) = "A1"

aryExport(1,0) = "CH25"

aryExport(1,1) = "Visual Display-Hotel TV"

aryExport(1,2) = "G2"

aryExport(1,3) = "image"

aryExport(1,4) = "G1"

Dim objExcelWorkbook 'as Excel.Workbook

Set objExcelWorkbook = copyObjectsToExcelSheet(ActiveDocument, aryExport)

end sub

sub exportToExcel_Visual_Display_MonitorLCD

Dim aryExport(1,4)

aryExport(0,0) = "CH15"

aryExport(0,1) = "Visual Display-Monitor LCD"

aryExport(0,2) = "A2"

aryExport(0,3) = "data"

aryExport(0,4) = "A1"

aryExport(1,0) = "CH13"

aryExport(1,1) = "Visual Display-Monitor LCD"

aryExport(1,2) = "G2"

aryExport(1,3) = "image"

aryExport(1,4) = "G1"

Dim objExcelWorkbook 'as Excel.Workbook

Set objExcelWorkbook = copyObjectsToExcelSheet(ActiveDocument, aryExport)

end sub

sub exportToExcel_Parts_Memory

Dim aryExport(1,4)

aryExport(0,0) = "CH116"

aryExport(0,1) = "Parts-Memory"

aryExport(0,2) = "A2"

aryExport(0,3) = "data"

aryExport(0,4) = "A1"

aryExport(1,0) = "CH115"

aryExport(1,1) = "Parts-Memory"

aryExport(1,2) = "G2"

aryExport(1,3) = "image"

aryExport(1,4) = "G1"

Dim objExcelWorkbook 'as Excel.Workbook

Set objExcelWorkbook = copyObjectsToExcelSheet(ActiveDocument, aryExport)

end sub

sub exportToExcel_Division_50

Dim aryExport(1,4)

aryExport(0,0) = "CH108"

aryExport(0,1) = "Division 50"

aryExport(0,2) = "A2"

aryExport(0,3) = "data"

aryExport(0,4) = "A1"

aryExport(1,0) = "CH107"

aryExport(1,1) = "Division 50"

aryExport(1,2) = "G2"

aryExport(1,3) = "image"

aryExport(1,4) = "G1"

Dim objExcelWorkbook 'as Excel.Workbook

Set objExcelWorkbook = copyObjectsToExcelSheet(ActiveDocument, aryExport)

end sub

'//------------------------------------- LARGE ACCOUNTS ---------------------------------------------

sub exportToExcel_LA_01

Dim aryExport(1,4)

aryExport(0,0) = "CHLA01"

aryExport(0,1) = "Visual Display-LFD-Mon.Opt"

aryExport(0,2) = "A2"

aryExport(0,3) = "data"

aryExport(0,4) = "A1"

aryExport(1,0) = "CHLA02"

aryExport(1,1) = "Visual Display-LFD-Mon.Opt"

aryExport(1,2) = "G2"

aryExport(1,3) = "image"

aryExport(1,4) = "G1"

Dim objExcelWorkbook 'as Excel.Workbook

Set objExcelWorkbook = copyObjectsToExcelSheet(ActiveDocument, aryExport)

end sub

sub exportToExcel_LA_11

Dim aryExport(1,4)

aryExport(0,0) = "CHLA11"

aryExport(0,1) = "Visual Display-Mon.LCD"

aryExport(0,2) = "A2"

aryExport(0,3) = "data"

aryExport(0,4) = "A1"

aryExport(1,0) = "CHLA12"

aryExport(1,1) = "Visual Display-Mon.LCD"

aryExport(1,2) = "G2"

aryExport(1,3) = "image"

aryExport(1,4) = "G1"

Dim objExcelWorkbook 'as Excel.Workbook

Set objExcelWorkbook = copyObjectsToExcelSheet(ActiveDocument, aryExport)

end sub

sub exportToExcel_LA_21

Dim aryExport(1,4)

aryExport(0,0) = "CHLA21"

aryExport(0,1) = "A4"

aryExport(0,2) = "A2"

aryExport(0,3) = "data"

aryExport(0,4) = "A1"

aryExport(1,0) = "CHLA22"

aryExport(1,1) = "A4"

aryExport(1,2) = "G2"

aryExport(1,3) = "image"

aryExport(1,4) = "G1"

Dim objExcelWorkbook 'as Excel.Workbook

Set objExcelWorkbook = copyObjectsToExcelSheet(ActiveDocument, aryExport)

end sub

sub exportToExcel_LA_31

Dim aryExport(1,4)

aryExport(0,0) = "CHLA31"

aryExport(0,1) = "A3"

aryExport(0,2) = "A2"

aryExport(0,3) = "data"

aryExport(0,4) = "A1"

aryExport(1,0) = "CHLA32"

aryExport(1,1) = "A3"

aryExport(1,2) = "G2"

aryExport(1,3) = "image"

aryExport(1,4) = "G1"

Dim objExcelWorkbook 'as Excel.Workbook

Set objExcelWorkbook = copyObjectsToExcelSheet(ActiveDocument, aryExport)

end sub

sub exportToExcel_LA_51

Dim aryExport(1,4)

aryExport(0,0) = "CHLA51"

aryExport(0,1) = "Parts"

aryExport(0,2) = "A2"

aryExport(0,3) = "data"

aryExport(0,4) = "A1"

aryExport(1,0) = "CHLA52"

aryExport(1,1) = "Parts"

aryExport(1,2) = "G2"

aryExport(1,3) = "image"

aryExport(1,4) = "G1"

Dim objExcelWorkbook 'as Excel.Workbook

Set objExcelWorkbook = copyObjectsToExcelSheet(ActiveDocument, aryExport)

end sub

sub exportToExcel_LA_41

Dim aryExport(1,4)

aryExport(0,0) = "CHLA41"

aryExport(0,1) = "Div.50"

aryExport(0,2) = "A2"

aryExport(0,3) = "data"

aryExport(0,4) = "A1"

aryExport(1,0) = "CHLA42"

aryExport(1,1) = "Div.50"

aryExport(1,2) = "G2"

aryExport(1,3) = "image"

aryExport(1,4) = "G1"

Dim objExcelWorkbook 'as Excel.Workbook

Set objExcelWorkbook = copyObjectsToExcelSheet(ActiveDocument, aryExport)

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

'// Introdotto da A.Saccone

'// 4 - Range in Excel where object's caption should be pasted

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

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

Dim sheetRangeCapt

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)

sheetRangeCapt = aryExportDefinition(i,4)

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

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

'Inserimento del Caption dell'oggetto

chartCaption = objSource.GetCaption.Name.v

objCurrentSheet.Range(sheetRangeCapt) = chartCaption

if (pasteMode <> "image") then

With objExcelApp.Selection

.WrapText = False

.ShrinkToFit = False

End With

end if

objCurrentSheet.Range("A1").Select

end if

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

'// 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 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

'//__________________________________________________________________

topic Re: Exporting tables to excel in QlikView

Exporting tables to excel

Re: Exporting tables to excel

Re: Exporting tables to excel

Re: Exporting tables to excel

Re: Exporting tables to excel