common Macro to export excel for 6 different objects

[#1]

m usinga macro to export excel from a object pivot chart,

i have 6 sheets with one pivot table, obviously they r having diff object ids

so can i have a single macro which can be trigerred through a button and w.r.t opened sheet export excel

or i hav to create macro for diff objects ????????????

[rustyfishbones]

Try this, here is a link to where I got the below code

http://www.qlikblog.at/971/qliktip-32-exporting-multiple-objects-single-excel-document/

sub exportToExcel_Variant1

'// Array for export definitions

Dim aryExport(0,3)

aryExport(0,0) = "CH42"

aryExport(0,1) = "Sales per Region a. Year"

aryExport(0,2) = "A1"

aryExport(0,3) = "image"

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) = "CH48"

aryExport(0,1) = "Sales per Region"

aryExport(0,2) = "G1"

aryExport(0,3) = "image"

aryExport(1,0) = "objCustomerDetailsSheet2012ONLY"

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) = "CH48"

aryExport(0,1) = "Sales Overview"

aryExport(0,2) = "A1"

aryExport(0,3) = "image"

aryExport(1,0) = "CH51"

aryExport(1,1) = "Top Customers"

aryExport(1,2) = "A1"

aryExport(1,3) = "data"

aryExport(2,0) = "CH42"

aryExport(2,1) = "Sales Overview"

aryExport(2,2) = "A14"

aryExport(2,3) = "image"

aryExport(3,0) = "CH50"

aryExport(3,1) = "Sales Overview"

aryExport(3,2) = "H1"

aryExport(3,3) = "image"

aryExport(4,0) = "CH74"

aryExport(4,1) = "Pivot"

aryExport(4,2) = "B3"

aryExport(4,3) = "image"

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

          '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

'//__________________________________________________________________

[#3]

The Macro works vrry well, but I have a problem when I try to save the Excel Document in the PC.

[#4]

Thanks Allan,

will try tht and will update u the results

[#5]

Hi,

If didnt select any Search Criteria my export is not working...My requirement is i have to export all the objects when the user clicks...orelse i have to export only one Data grid which is static...Can you help me on this.

[v_iyyappan]

Hi,

Using below macro code u can create the folder in dynamically and saved the file,

vPath = Ur path folder i.e  D:\\Test\

strDate = Year(Date()) &"-"& month(date()) &"-"& Day(Date())

set vPathName = ActiveDocument.Variables("vPath")

GetVarValue = vPathName.GetContent.String

Dim filesys

Dim newfolder

set filesys=CreateObject("Scripting.FileSystemObject")

  If Not filesys.FolderExists(GetVarValue) Then

    Set newfolder = filesys.CreateFolder(GetVarValue)     

    filePath = newfolder&"\Test_"&strDate&".xlsx"

  Else

    filePath = GetVarValue&"\Test_"&strDate&".xlsx"   

  End If

objExcelDoc.SaveAs filePath

Regards,

[#7]

I am new in the QV, and I also have a problem when I try to save the Excel Document and the PC.

Please help!

  When you say "below Using macro code" exactly where you think it should be copied, under the "Set objExcelWorkbook = copyObjectsToExcelSheet (ActiveDocument, aryExport)" or ...?

vPath = Ur folder path i.e 😧 \\ Test \

strDate = Year (Date ()) & "-" & month (date ()) & "-" & Day (Date ())

set vPathName ActiveDocument.Variables = ("vPath")

GetVarValue = vPathName.GetContent.String

dim filesys

dim newfolder

set filesys = CreateObject ("Scripting.FileSystemObject")

   If Not filesys.FolderExists (GetVarValue) Then

     Set newfolder = filesys.CreateFolder (GetVarValue)

     filePath = newfolder & "\ Test _" & strDate & ". xlsx"

   else

     filePath = GetVarValue & "\ Test _" & strDate & ". xlsx"

   end If

objExcelDoc.SaveAs filePath

[tamilarasu]

Hi Zeljko.

Please start a new thread and elaborate your issue. You might get quick response.

[#9]

OK , sorry

[#10]

Just one more question, how to send mail with specific sheet for example, in this case sheet "Sales Overview"?