Export Macro not working

[samuel_brierley]

Hi all,

ive pinched the below from QlikTip #32: Exporting multiple QV objects to a single Excel document but it doesn't seem to do anything at all, obviously im going wrong somewhere but I cant identify the problem.

ive tried using the CH number and setting it as obj to see if that changes anything but no joy.

thanks for any help guys.

sub test()
Dim aryExport(0,3)

set obj = ActiveDocument.GetSheetObject("CH127")

aryExport(0,0) = "CH127"
aryExport(0,1) = "Sales per Region"
aryExport(0,2) = "A1"
aryExport(0,3) = "data"


Dim objExcelWorkbook 'as Excel.Workbook
Set objExcelWorkbook = copyObjectsToExcelSheet(ActiveDocument, aryExport)

end sub

[gautik92]

have a look at this

[samuel_brierley]

I'm a PE user unfortunately getting closer to getting IT to get me a license.

sorry

[gautik92]

have a look at this macro

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

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

            .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

'//__________________________________________________________________

[samuel_brierley]

Hi,

as far as I can tell the top code is the same as what im using but to be on the safe side I copied it only changing the chart name to CH01.

still no joy and I haven't got a clue why? excel doesn't start and obviously no data is copied across.

i've attached a simple qvw with a button, id appreciate if you can just try the button and see whats going on.

obviously have a quick scan of the code but I cant see anything wrong

thanks

[#6 · Accepted solution]

Hi Samuel,

in your macro it lacked all part that builds dinammicamente the excel file.

Do not remove all of the code that I added, allowing access to the file system in the macro.

Look at the attachment, this works.

[samuel_brierley]

ahh brilliant thanks,

unfortunately im only a PE user, can you please paste into a text file or just into here?

thanks

[#8]

Hi Samuel,

this is the macro code:

sub exportToExcel_Variant1

'// Array for export definitions

Dim aryExport(0,3)

aryExport(0,0) = "CH01"

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

'// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

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

            .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

'//__________________________________________________________________