VBScript Line Chart Export to Excel - Qlik Community

haymarketpaul · ‎2016-04-11

QV11 SR4

I use VBScript to construct an Excel Document which works fine.

I would also like to export/paste a Line Chart to an Excel Sheet via VBScript.

When i attempt to export my line chart with the following...

ActiveDocument.GetSheetObject("CH_Contacts").CopyTableToClipboard True

XLSheet2.Paste XLSheet2.Cells(num_rows+4,num_cols-10)

...Instead of pasting the chart it just pastes the values the chart is based on as a straight table.

Is there a way to paste/export the actual line chart as a line chart ?

tamilarasu · ‎2016-04-11

Hi Paul,

Use CopyBitmapToClipboard instead of CopyTableToClipboard.

ActiveDocument.GetSheetObject("CH_Contacts").CopyBitmapToClipboard True

haymarketpaul · ‎2016-04-11

Thanks - yes tried that but it just jumps to the script when it reaches that line so i assume it doesn't like it.

Here's the full relevant part of the script that works great except for the two lines i mention above (which i've commented out here - 3rd and 4th last lines) Not sure how to format this properly here....

'***********************************************************

' Sheet 2 - Running table counts

'***********************************************************

XLSheet2.Activate

'Add Running Count values

objExcel.ActiveSheet.Name = "Running Counts"		'Rename sheet 2
objExcel.ActiveSheet.Tab.ColorIndex = 10			'set tab colour to green

'widen worksheet columns to stop text wrapping in cells

With objExcel

	.Worksheets(2).Columns("A").ColumnWidth = 40
	.Worksheets(2).Columns("B").ColumnWidth = 40
	.Worksheets(2).Columns("C").ColumnWidth = 0	'Hide the empty column

End With

ActiveDocument.GetSheetObject("CH_Counts").CopyTableToClipboard True 'copy QV results chart to clipboard

XLSheet2.Paste XLSheet2.Range("A1")			'paste in QV results pivot chart at cell A1 on sheet2
objExcel.Worksheets(2).Rows("1").HorizontalAlignment = -4130	'left align header row on first sheet
objExcel.Worksheets(2).Rows("1").Font.Bold = True		'Bold header row

XLSheet2.UsedRange.Columns.AutoFit		'autofit each column width
XLSheet2.Columns("C").ColumnWidth = 0	'rehide the empty column

	num_rows = objExcel.Worksheets(2).UsedRange.Rows.Count			'last used row
	num_cols = objExcel.Worksheets(2).UsedRange.Columns.Count		'last used column

'Loop through all the cells looking for any negative count drops
For i = 2 to num_rows			'ignore header row
For j = 4 to num_cols		'ignore first three static columns
	If InStr(XLSheet2.Cells(i,j).Value,"-") Then 'if a negative count is detected...
		XLSheet2.Cells(i,j).Font.ColorIndex = 3	'...change font colour to red
	End If
Next
Next

' ActiveDocument.GetSheetObject("CH_Contacts").CopyTableToClipboard True

' XLSheet2.Paste XLSheet2.Cells(num_rows+4,num_cols-10)

objExcel.Range("C2").Select

'Freeze first row and first 2 columns + the hidden column

objExcel.ActiveWindow.FreezePanes = True

haymarketpaul · ‎2016-04-11

hmm that didn't paste very well

tamilarasu · ‎2016-04-11

I don't think this is a full code. I just opened my laptop only for you. Could you paste full code, so that I can check line by line.?

haymarketpaul · ‎2016-04-11

ok here's the whole subroutine....

Sub ExportToExcel()

'***************************************************************************

'write and format results to excel

'***************************************************************************

strPathExcel = "H:\Circulation\Data ops\Blue Sheep\Daily Report File\"

strFile = "Audit_Report_"

strSaveFile = strPathExcel & strFile

Set objExcel = CreateObject("Excel.Application")

With objExcel

.Visible = False

Set XLDoc = .Workbooks.Add 'new workbook

.ActiveWorkBook.Worksheets.Add 'new worksheet within new workbook

'create a worksheet

Set XLSheet = .Worksheets(1) 'Daily Data

Set XLSheet2 = .Worksheets(2) 'Running Count Details

Set XLSheet3 = .Worksheets(3) 'RACI Details

Set XLSheet4 = .Worksheets(4) 'Feed Details

End With

'***********************************************************

' Sheet 1 - DCLog tab info

'***********************************************************

'widen worksheet columns to stop text wrapping in cells

With objExcel

.Worksheets(1).Columns("A").ColumnWidth = 45

.Worksheets(1).Columns("B").ColumnWidth = 35

.Worksheets(1).Columns("C").ColumnWidth = 0 'Hide the empty column

End With

ActiveDocument.GetSheetObject("CH_Audit").CopyTableToClipboard true 'copy QV results chart to clipboard

XLSheet.Paste XLSheet.Range("A1") 'paste in QV results pivot chart at cell A1 on sheet1

objExcel.ActiveSheet.Name = "Daily Data Load - Audit Report" 'rename sheet 1

objExcel.ActiveSheet.Tab.ColorIndex = 3 'set tab colour to red

objExcel.Worksheets(1).Rows("1").HorizontalAlignment = -4130 'left align header row on first sheet

objExcel.Worksheets(1).Rows("1").Font.Bold = True 'Bold header row

XLSheet.UsedRange.Columns.AutoFit 'autofit each column width

XLSheet.Columns("C").ColumnWidth = 0 'rehide the empty column

objExcel.Range("D2").Select 'Freeze first row and first 3 columns + the hidden column

objExcel.ActiveWindow.FreezePanes = True

'***********************************************************

'Compare last 2 column values to check for 10% changes

'***********************************************************

XLSheet.Activate 'set focus back to the main worksheet

num_rows = objExcel.Worksheets(1).UsedRange.Rows.Count 'last used row

num_cols = objExcel.Worksheets(1).UsedRange.Columns.Count 'last used column

'need to check for the possible 10% rise between the previous days results and todays

For i = 2 to num_rows 'loop through all the rows except the header row

If XLSheet.Cells(i,num_cols).Value <> "-" Then 'no 10% rise so ignore row

TodayValue = XLSheet.Cells(i,num_cols).Value 'store todays value for each row

YesterdayValue = XLSheet.Cells(i,num_cols-1).Value 'store yesterdays value for each row

If InStr(TodayValue," ") Then 'check for space before bracket if exists for today value

'get first value before the bracket and convert to integer...

TodayValue = CLng(Split(TodayValue," ")(LBound(Split(TodayValue," "))))

End If

If InStr(YesterdayValue," ") Then 'check for space before bracket if exists for previous day value

'get first value before the bracket and convert to integer...

YesterdayValue = CLng(Split(YesterdayValue," ")(LBound(Split(YesterdayValue," "))))

End If

If YesterdayValue = "-" Then

TenPercent = 0 '0 if no figures for yesterday

XLSheet.Cells(i,num_cols).Font.ColorIndex = 3 'change font colour to red

Else

TenPercent = (YesterdayValue / 100) * 10 '10% of previous days value

If TodayValue >= YesterdayValue + TenPercent Then 'compare today against yesterday + 10%

XLSheet.Cells(i,num_cols).Font.ColorIndex = 3 'if equal to or greater than 10% change font colour to red

End If

' Sheet 2 - Running table counts

'***********************************************************

XLSheet2.Activate

'Add Running Count values

objExcel.ActiveSheet.Name = "Running Counts" 'Rename sheet 2

objExcel.ActiveSheet.Tab.ColorIndex = 10 'set tab colour to green

'widen worksheet columns to stop text wrapping in cells

With objExcel

.Worksheets(2).Columns("A").ColumnWidth = 40

.Worksheets(2).Columns("B").ColumnWidth = 40

.Worksheets(2).Columns("C").ColumnWidth = 0 'Hide the empty column

End With

ActiveDocument.GetSheetObject("CH_Counts").CopyTableToClipboard True 'copy QV results chart to clipboard

XLSheet2.Paste XLSheet2.Range("A1") 'paste in QV results pivot chart at cell A1 on sheet2

objExcel.Worksheets(2).Rows("1").HorizontalAlignment = -4130 'left align header row on first sheet

objExcel.Worksheets(2).Rows("1").Font.Bold = True 'Bold header row

XLSheet2.UsedRange.Columns.AutoFit 'autofit each column width

XLSheet2.Columns("C").ColumnWidth = 0 'rehide the empty column

num_rows = objExcel.Worksheets(2).UsedRange.Rows.Count 'last used row

num_cols = objExcel.Worksheets(2).UsedRange.Columns.Count 'last used column

'Loop through all the cells looking for any negative count drops

For i = 2 to num_rows 'ignore header row

For j = 4 to num_cols 'ignore first three static columns

If InStr(XLSheet2.Cells(i,j).Value,"-") Then 'if a negative count is detected...

XLSheet2.Cells(i,j).Font.ColorIndex = 3 '...change font colour to red

End If

' ActiveDocument.GetSheetObject("CH_Contacts").CopyBitmapToClipboard True

' XLSheet2.Paste XLSheet2.Cells(num_rows+4,num_cols-10)

objExcel.Range("C2").Select 'Freeze first row and first 2 columns + the hidden column

objExcel.ActiveWindow.FreezePanes = True

'***********************************************************

' Sheet 3 - Source Owners

'***********************************************************

XLSheet3.Activate

'Add RACI details

objExcel.ActiveSheet.Name = "RACI" 'Rename sheet 3

objExcel.ActiveSheet.Tab.ColorIndex = 23 'set tab colour to blue

'widen worksheet columns to stop text wrapping in cells

With objExcel

.Worksheets(3).Columns("A").ColumnWidth = 40

.Worksheets(3).Columns("B").ColumnWidth = 40

.Worksheets(3).Columns("C").ColumnWidth = 40

.Worksheets(3).Columns("D").ColumnWidth = 50

.Worksheets(3).Columns("E").ColumnWidth = 50

End With

ActiveDocument.GetSheetObject("TB_SourceContacts").CopyTableToClipboard true 'copy QV results table to clipboard

XLSheet3.Paste XLSheet3.Range("A1") 'paste in QV results at cell A1 on sheet3 'paste in QV results table chart at cell A1 on sheet2

objExcel.Worksheets(3).Rows("1").HorizontalAlignment = -4130 'left align header row on first sheet

objExcel.Worksheets(3).Rows("1").Font.Bold = True 'Bold header row

XLSheet3.UsedRange.Columns.AutoFit 'autofit each column width

'***********************************************************

' Sheet 4 - Feed Details

'***********************************************************

XLSheet4.Activate

'Add Feed details

objExcel.ActiveSheet.Name = "Feeds" 'Rename sheet 4

objExcel.ActiveSheet.Tab.ColorIndex = 29 'set tab colour to purple

'widen worksheet columns to stop text wrapping in cells

With objExcel

.Worksheets(4).Columns("A").ColumnWidth = 40

.Worksheets(4).Columns("B").ColumnWidth = 40

.Worksheets(4).Columns("C").ColumnWidth = 40

.Worksheets(4).Columns("D").ColumnWidth = 50

End With

ActiveDocument.GetSheetObject("TB_Feeds").CopyTableToClipboard true 'copy QV results table to clipboard

XLSheet4.Paste XLSheet4.Range("A1") 'paste in QV results at cell A1 on sheet4 'paste in QV results table chart at cell A1 on sheet2

objExcel.Worksheets(4).Rows("1").HorizontalAlignment = -4130 'left align header row on first sheet

objExcel.Worksheets(4).Rows("1").Font.Bold = True 'Bold header row

XLSheet4.UsedRange.Columns.AutoFit 'autofit each column width

objExcel.Range("A2").Select 'Freeze header row

objExcel.ActiveWindow.FreezePanes = True

'***********************************************************

'Finalise and save the spreadsheet

'***********************************************************

XLSheet.Activate 'set focus back to the main worksheet

objExcel.Sheets("Sheet1").Delete 'remove the blank default worksheet - sheet1

objExcel.DisplayAlerts = False 'disable any popup messages that may appear such as the overwrite existing file message

objExcel.ActiveWorkBook.SaveAs strSaveFile & replace(date, "/", "-") & ".xlsx" 'save file with todays date, apply pswd and overwrite if it exists already

objExcel.DisplayAlerts = True

objExcel.Quit 'Close spreadsheet

Set objExcel = Nothing 'clear objects from memory

Set XLDoc = Nothing

Msgbox "Spreadsheet Saved"

End Sub

haymarketpaul · ‎2016-04-11

I've attached the qvw - the line chart is on the Running Counts Tab the export macro button is on the DCLog tab

tamilarasu · ‎2016-04-11

Paul, I could see lots of unwanted lines in the above code. I have personal edition in my laptop, so I couldn't open yours. I have no debugger in my laptop, so I feel hard to type the syntax. I can complete it by tomorrow morning, when i get into my office. Sorry. I hope someone will jump in and help you. If not, I'll post it by tomorrow morning.

haymarketpaul · ‎2016-04-11

Ok thanks Tamil - i'm off home for the day shortly anyway - Thanks for your help - look forward to your reply tomorrow

haymarketpaul · ‎2016-04-12

NB: If i simply attempt to export the line chart into an Excel sheet that hasn't been pre-formatted then CopyBitmapToClipboard works fine.

So something in the other formatting i'm doing on my Running Counts Sheet (freezing and/or hiding columns i suspect) is preventing the line chart from pasting as a line chart.