Unlock a world of possibilities! Login now and discover the exclusive benefits awaiting you.
Hi Friends,
I created button to run macro, when I test in module,the charts are exporting to Excel,
But it is not working when I clicked the button on dashboard.
I selected System Access and Allow System Access also, i named my macro. Anyone knows why it is not working? please help me
below is my code, if i need to do any changes please let me know.
sub exportToExcel_Variant3
Dim aryExport(10,3)
aryExport(0,0) = "CH20"
aryExport(0,1) = "Breakdown"
aryExport(0,2) = "A1"
aryExport(0,3) = "data"
aryExport(1,0) = "CH21"
aryExport(1,1) = "Breakdown"
aryExport(1,2) = "A20"
aryExport(1,3) = "data"
aryExport(2,0) = "CH22"
aryExport(2,1) = "Breakdown"
aryExport(2,2) = "A41"
aryExport(2,3) = "data"
aryExport(3,0) = "CH34"
aryExport(3,1) = "Breakdown"
aryExport(3,2) = "A57"
aryExport(3,3) = "data"
aryExport(4,0) = "CH23"
aryExport(4,1) = "Breakdown"
aryExport(4,2) = "A75"
aryExport(4,3) = "data"
aryExport(5,0) = "CH24"
aryExport(5,1) = "Breakdown"
aryExport(5,2) = "A92"
aryExport(5,3) = "data"
aryExport(6,0) = "CH25"
aryExport(6,1) = "Breakdown"
aryExport(6,2) = "A110"
aryExport(6,3) = "data"
aryExport(7,0) = "CH26"
aryExport(7,1) = "Breakdown"
aryExport(7,2) = "A127"
aryExport(7,3) = "data"
aryExport(8,0) = "CH28"
aryExport(8,1) = "Breakdown"
aryExport(8,2) = "A145"
aryExport(8,3) = "data"
aryExport(9,0) = "CH32"
aryExport(9,1) = "Breakdown"
aryExport(9,2) = "A158"
aryExport(9,3) = "data"
aryExport(10,0) = "CH33"
aryExport(10,1) = "Breakdown"
aryExport(10,2) = "A168"
aryExport(10,3) = "data"
Dim objExcelWorkbook 'as Excel.Workbook
Set objExcelWorkbook = copyObjectsToExcelSheet(ActiveDocument, aryExport)
end sub
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)
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)
objExcelDoc.Sheets(1).Select
Set copyObjectsToExcelSheet = objExcelDoc
end function
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
Set Excel_GetSheetByName = nothing
End Function
Private Function Excel_GetSafeSheetName(sheetName)
retVal = trim(left(sheetName, 31))
Excel_GetSafeSheetName = retVal
End Function
Private Function Excel_AddSheet(objExcelApplication, sheetName) ' as Excel.Sheet
objExcelApplication.Sheets.Add , objExcelApplication.Sheets(objExcelApplication.Sheets.Count)
Dim objNewSheet
Set objNewSheet = objExcelApplication.Sheets(objExcelApplication.Sheets.Count)
objNewSheet.Name = left(sheetName,31)
Set Excel_AddSheet = objNewSheet
End function
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
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
hi sowmya,
please chk below link for macros..
hope that helps u to chk which one is gud
Hi,
Hope you have selected access options correctly.
Refer to attached screen shot. You will have to "Allow System Access" option.
Thanks.
Will only work with Plugin as client, not WebView (Ajax).
Hi Jerry,
Thanks for the reply, what i have to do now to resolve this issue?
Hi Prasant,
I have done that.
If you want it to work for clients they have to use Plugin as client.
This is not possible to with Webview(Ajax) as client.
Alternative : Have a look at Qlik Printing (NPrinting)
Hi Jerry,
How can i install NPrinting in my machine?currently i am using personal edition at my work station.