Unlock a world of possibilities! Login now and discover the exclusive benefits awaiting you.
Announcements
Qlik Open Lakehouse is Now Generally Available! Discover the key highlights and partner resources here.
- Qlik Community
- :
- All Forums
- :
- QlikView App Dev
- :
- Macro error
Options
- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Mute
- Printer Friendly Page
Turn on suggestions
Auto-suggest helps you quickly narrow down your search results by suggesting possible matches as you type.
Showing results for
nareshthavidish
Creator III
2016-07-27
09:40 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Macro error
Hi ,
Am using the below macro to export objects to excel.But it gives the error "Script out of range".... Below is the script
Thanks..
750 Views
3 Replies
santiago_respan
Specialist
2016-07-27
10:06 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Hi,
i don't seem to see the script, please can you verify you uploaded correctly?
Kind regards,
Santiago
556 Views
Clever_Anjos
Employee
2016-07-27
10:29 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
No script attached
nareshthavidish
Creator III
2016-07-27
10:40 AM
Author
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Hi Below is the code:Am getting the error while running the exportToExcel_Variant5
sub exportToExcel_Variant4
Dim aryExport(4,3)
aryExport(0,0) = "CH23"
aryExport(0,1) = "Traffic Count By Month"
aryExport(0,2) = "A1"
aryExport(0,3) = "image"
aryExport(1,0) = "CH26"
aryExport(1,1) = "Sales By Month"
aryExport(1,2) = "A1"
aryExport(1,3) = "image"
aryExport(2,0) = "CH24"
aryExport(2,1) = "Top 10 Regional Preformers"
aryExport(2,2) = "A1"
aryExport(2,3) = "image"
aryExport(3,0) = "CH21"
aryExport(3,1) = "Sales Break Break Down By Year"
aryExport(3,2) = "A1"
aryExport(3,3) = "image"
aryExport(4,0) = "CH27"
aryExport(4,1) = "Traffic Count "
aryExport(4,2) = "A1"
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 subsub exportToExcel_Variant5
Dim aryExport(3,3) aryExport(0,0) = "CH18"
aryExport(0,1) = "Traffic Count"
aryExport(0,2) = "A1"
aryExport(0,3) = "image"
'
'
aryExport(1,0) = "CH17"
aryExport(1,1) = "Top Performers"
aryExport(1,2) = "A1"
aryExport(1,3) = "image"
aryExport(2,0) = "CH07"
aryExport(2,1) = "Traffic Count Trend"
aryExport(2,2) = "A1"
aryExport(2,3) = "image"
'
'
aryExport(3,0) = "CH16"
aryExport(3,1) = "Top 10 locations on Traffic count"
aryExport(3,2) = "A1"
aryExport(3,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 Functionsub exportToExcel_Variant5Dim aryExport(4,3) aryExport(0,0) = "CH17"
aryExport(0,1) = "Top Performers"
aryExport(0,2) = "A1"
aryExport(0,3) = "image"aryExport(1,0) = "CH07"
aryExport(1,1) = "Traffic Count Trend"
aryExport(1,2) = "A1"
aryExport(1,3) = "image"aryExport(2,0) = "CH16"
aryExport(2,1) = "Top 10 locations on Traffic count"
aryExport(2,2) = "A1"
aryExport(2,3) = "image"aryExport(3,0) = "CH18"
aryExport(3,1) = "Traffic Count Analysis"
aryExport(3,2) = "A1"
aryExport(3,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'sub exportToExcel_Variant5
'
'Dim aryExport(3,3)
'
'
'aryExport(0,0) = "CH18"
'aryExport(0,1) = "Traffic Count"
'aryExport(0,2) = "A1"
'aryExport(0,3) = "image"
'
'
'aryExport(1,0) = "CH17"
'aryExport(1,1) = "Top Performers"
'aryExport(1,2) = "A1"
'aryExport(1,3) = "image"
'
'
'aryExport(2,0) = "CH07"
'aryExport(2,1) = "Traffic Count Trend"
'aryExport(2,2) = "A1"
'aryExport(2,3) = "image"
'
'
'aryExport(3,0) = "CH16"
'aryExport(3,1) = "Top 10 locations on Traffic count"
'aryExport(3,2) = "A1"
'aryExport(3,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
'
''//__________________________________________________sub exportToExcel_Variant6
Dim aryExport(1,3)
aryExport(0,0) = "CH36"
aryExport(0,1) = "Traffic Count Trend Store"
aryExport(0,2) = "A1"
aryExport(0,3) = "image"
aryExport(1,0) = "CH35"
aryExport(1,1) = "Sales Trend"
aryExport(1,2) = "A1"
aryExport(1,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
'sub exportToExcel_Variant5
'
'
'Dim aryExport(1,3)
'
'
'aryExport(0,0) = "CH36"
'aryExport(0,1) = "Traffic Count Trend"
'aryExport(0,2) = "A1"
'aryExport(0,3) = "image"
'
'
'aryExport(1,0) = "CH35"
'aryExport(1,1) = "Sales Trend "
'aryExport(1,2) = "A1"
'aryExport(1,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
Dim aryExport(4,3)
aryExport(0,0) = "CH23"
aryExport(0,1) = "Traffic Count By Month"
aryExport(0,2) = "A1"
aryExport(0,3) = "image"
aryExport(1,0) = "CH26"
aryExport(1,1) = "Sales By Month"
aryExport(1,2) = "A1"
aryExport(1,3) = "image"
aryExport(2,0) = "CH24"
aryExport(2,1) = "Top 10 Regional Preformers"
aryExport(2,2) = "A1"
aryExport(2,3) = "image"
aryExport(3,0) = "CH21"
aryExport(3,1) = "Sales Break Break Down By Year"
aryExport(3,2) = "A1"
aryExport(3,3) = "image"
aryExport(4,0) = "CH27"
aryExport(4,1) = "Traffic Count "
aryExport(4,2) = "A1"
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 subsub exportToExcel_Variant5
Dim aryExport(3,3) aryExport(0,0) = "CH18"
aryExport(0,1) = "Traffic Count"
aryExport(0,2) = "A1"
aryExport(0,3) = "image"
'
'
aryExport(1,0) = "CH17"
aryExport(1,1) = "Top Performers"
aryExport(1,2) = "A1"
aryExport(1,3) = "image"
aryExport(2,0) = "CH07"
aryExport(2,1) = "Traffic Count Trend"
aryExport(2,2) = "A1"
aryExport(2,3) = "image"
'
'
aryExport(3,0) = "CH16"
aryExport(3,1) = "Top 10 locations on Traffic count"
aryExport(3,2) = "A1"
aryExport(3,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 Functionsub exportToExcel_Variant5Dim aryExport(4,3) aryExport(0,0) = "CH17"
aryExport(0,1) = "Top Performers"
aryExport(0,2) = "A1"
aryExport(0,3) = "image"aryExport(1,0) = "CH07"
aryExport(1,1) = "Traffic Count Trend"
aryExport(1,2) = "A1"
aryExport(1,3) = "image"aryExport(2,0) = "CH16"
aryExport(2,1) = "Top 10 locations on Traffic count"
aryExport(2,2) = "A1"
aryExport(2,3) = "image"aryExport(3,0) = "CH18"
aryExport(3,1) = "Traffic Count Analysis"
aryExport(3,2) = "A1"
aryExport(3,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'sub exportToExcel_Variant5
'
'Dim aryExport(3,3)
'
'
'aryExport(0,0) = "CH18"
'aryExport(0,1) = "Traffic Count"
'aryExport(0,2) = "A1"
'aryExport(0,3) = "image"
'
'
'aryExport(1,0) = "CH17"
'aryExport(1,1) = "Top Performers"
'aryExport(1,2) = "A1"
'aryExport(1,3) = "image"
'
'
'aryExport(2,0) = "CH07"
'aryExport(2,1) = "Traffic Count Trend"
'aryExport(2,2) = "A1"
'aryExport(2,3) = "image"
'
'
'aryExport(3,0) = "CH16"
'aryExport(3,1) = "Top 10 locations on Traffic count"
'aryExport(3,2) = "A1"
'aryExport(3,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
'
''//__________________________________________________sub exportToExcel_Variant6
Dim aryExport(1,3)
aryExport(0,0) = "CH36"
aryExport(0,1) = "Traffic Count Trend Store"
aryExport(0,2) = "A1"
aryExport(0,3) = "image"
aryExport(1,0) = "CH35"
aryExport(1,1) = "Sales Trend"
aryExport(1,2) = "A1"
aryExport(1,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
'sub exportToExcel_Variant5
'
'
'Dim aryExport(1,3)
'
'
'aryExport(0,0) = "CH36"
'aryExport(0,1) = "Traffic Count Trend"
'aryExport(0,2) = "A1"
'aryExport(0,3) = "image"
'
'
'aryExport(1,0) = "CH35"
'aryExport(1,1) = "Sales Trend "
'aryExport(1,2) = "A1"
'aryExport(1,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
Thanks,
Kishore
556 Views
