Unlock a world of possibilities! Login now and discover the exclusive benefits awaiting you.
- Qlik Community
- :
- All Forums
- :
- QlikView App Dev
- :
- Export Data to Excel in Different Sheets
- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Mute
- Printer Friendly Page
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Export Data to Excel in Different Sheets
I was able to create the following code from various posts, I am not very good at vBA and I am hoping someone could help me with why this is not working -
Qview does not seem to do what I want it to do, which is cycle through the charts in the sheet and export the data into diferent excel sheets, it doe snot provide an error message either. Or at leats explain if there is a debug option to trace it, I can't seem to find it (like I said, little experience with vBA). Eventually i want it to also cycle thrtough first 8 sheets, but I will deal withat later
Sub to_excel
Dim wsname
Set XLApp = CreateObject("Excel.Application")
XLApp.Visible = TRUE
Set XLDoc = XLApp.Workbooks.Add
strFileName = InputBox("Enter Path and File Name (from My Documents)", "Enter Path and Filename", defaultValue)
strFileName = "C:\Documents and Settings\ewnym5s\My Documents\" & strFileName
ActiveDocument.ClearAll
'For i = 1 To 8
Set MySheet = ActiveDocument.GetSheet("SH02")
MyCharts=MySheet.GetSheetObjects
For X =lbound(MyCharts) to ubound(MyCharts)
ActiveDocument.Sheets("SH02").Activate
Set obj = ActiveDocument.GetSheetObject(MyCharts(X).GetObjectId)
IF Obj.GetObjectType >= 10 AND Obj.GetObjectType =< 16 Then
wsname = Obj.GetObjectId
XLDOC.Worksheets.Add().Name = wsname
XLDoc.Sheets(wsname).activate
obj.CopyTableToClipboard true
XLDoc.Sheets(wsname).Range("A" & 1).Select
XLDoc.Sheets(wsname).Paste
ActiveDocument.GetApplication.WaitForIdle
End if
Next
'Next
XLDoc.SaveAs(strFileName)
XLDoc.Close
end sub
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
'// ****************************************************************
'// 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
Dim
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
' save the workbook
' Save as New file
'objExcelDoc.SaveAs "H:\Loader\Reporting\Daily\DMM\Result\Daily_CCAR_DMM_Util_" + strCutoffDate + ".xlsx"
objExcelDoc.SaveAs "C:\Daily_CCAR_DMM_Util_20120806.xlsx"
objExcelDoc.Close True
objExcelApp.Close True
Set objExcelSheet = Nothing
Set objExcelDoc = Nothing
Set objExcelApp = Nothing
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
'//__________________________________________________________________
code above was posted by someone ..i forgot the name...
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
All,
I am pasting my solution. I am not sure it is the most effcient, nor elegant, but it works. If you specify an existing filename excel will prompt you to see if you want to override.
a few comments: in my example it does not cycle through all sheets, I only wanted the first 8.
The path and filename are assumed to be startying from My Documents, adjust as needed - if the directory does not exist i assume it will fail
It is naming the excel sheet as the first 30 chars of the chart title, which is the second line in the first tab of properties. It fails if that is empty - feel free to trap the error, I just made sure all my charts had that. I liked that better than CH23 whihc means nothing to me
I freely concede I borrowed shamelessly from the boards here and other web postings, I do not claim any authorship, just trying to help others.
Sub to_excel
Dim wsname
Set XLApp = CreateObject("Excel.Application")
XLApp.Visible = TRUE
Set XLDoc = XLApp.Workbooks.Add
Dim iRet
strFileName = InputBox("Enter Path and File Name (from My Documents)", "Enter Path and Filename", defaultValue)
strFileName = "C:\Documents and Settings\ewnym5s\My Documents\" & strFileName
For i = 1 To ActiveDocument.NoOfSheets -2
Set MySheet = ActiveDocument.GetSheet(i)
MySheet.Activate
MyCharts=MySheet.GetSheetObjects
For X =lbound(MyCharts) to ubound(MyCharts)
' ActiveDocument.Sheets("SH02").Activate
Set obj = ActiveDocument.GetSheetObject(MyCharts(X).GetObjectId)
IF Obj.GetObjectType >= 10 AND Obj.GetObjectType =< 16 Then
' k=inStr(1,obj.GetObjectId,"\")
' wsname = right(obj.GetObjectId,len(obj.GetObjectId)-k)
wsname = left(obj.getProperties.ChartProperties.Title.Title.v,30)
' iRet = MsgBox(wsname, vbOK, "Title")
XLDOC.Worksheets.Add().Name = wsname
XLDoc.Sheets(wsname).activate
obj.CopyTableToClipboard true
XLDoc.Sheets(wsname).Range("A" & 1).Select
XLDoc.Sheets(wsname).Paste
ActiveDocument.GetApplication.WaitForIdle
End if
Next
Next
XLDoc.SaveAs(strFileName)
XLDoc.Close
XLApp.Close
end sub