Qlik Community

QlikView App Dev

Discussion Board for collaboration related to QlikView App Development.

Announcements
QlikWorld 2022, LIVE in Denver CO., May 16-19, 2022. REGISTER NOW TO RECEIVE EARLY BIRD PRICING
cancel
Showing results for 
Search instead for 
Did you mean: 
haymarketpaul
Creator III
Creator III

VBScript Line Chart Export to Excel

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 ?

13 Replies
tamilarasu
Champion
Champion

Hi Paul,

Use  CopyBitmapToClipboard instead of CopyTableToClipboard.


ActiveDocument.GetSheetObject("CH_Contacts").CopyBitmapToClipboard True


haymarketpaul
Creator III
Creator III
Author

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
Creator III
Creator III
Author

hmm that didn't paste very well

tamilarasu
Champion
Champion

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
Creator III
Creator III
Author

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

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

        .ActiveWorkBook.Worksheets.Add    'new worksheet within 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

            End If

        End If

    Next

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

    '    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").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
Creator III
Creator III
Author

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

tamilarasu
Champion
Champion

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
Creator III
Creator III
Author

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

haymarketpaul
Creator III
Creator III
Author

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.