简体   繁体   中英

EXCEL 2010 VBA copying graphs

So I am confused on how excel copy/ paste works. I have a code which just copies one graph as a picture and paste's it in a new sheet.

    Worksheets(redemp).ChartObjects("Chart 6").CopyPicture
    pasteRow = pasteRow + 24
    Worksheets("print").Cells(pasteRow, 2).Select
    Worksheets("print").Paste

If I run the macro manually it works MOST of the time (with multiple excel files opened) If I run the macro via a VB script and NO other EXCEL file is open it works MOST of the time. If I run the macro via a VB script and another EXCEL file IS OPEN the code works 20% of the time and 80% of the time i get a 'Run Time error 1004: Paste paste method of worksheet class failed

I did quite a bit of research but have not found a solution yet. Any help appreciated.

CODE

    Private Sub changeAndCopy()
    'CHANGES THE COMPANY IN THE "Debt Redemption Sheet" AND COPY/PASTE'S (INFO AND REDEMPTION TABLES AND CHART) TO A NEW SHEET

    'CREATE VARIABLES WITH SHEET NAMES
        Dim redemp, auxil, pdf As String

        redemp = "Debt Redemptions Profile"
        auxil = "Auxiliary"
        pdf = "print"

    'CALL A SUB WHICH TAKES A SHEET NAME AS AN INPUT AND SETS THE ROW HEIGHT, FONT HEIGHT AND PRINTING MARGINS
        Call pageSetup(pdf, 10, 6)

    'SET VARIABLES FOR PASTING IN PRINTING SHEET (pasteCoL/RoW)
        Dim issuer_row1, issuer_rowL, i, pasteRow As Integer

        pasteCol = 1
        pasteRow = 1

    'FIND ROWS OF VARIABLES IN AUXILIARRY SHEET WITH COMPANY NAMES TO BE USED IN THE LOOP
        issuer_row1 = 3
        issuer_rowL = Worksheets(auxil).Cells(3, 2).End(xlDown).Row

        Worksheets(redemp).Cells(8, 4).Value = Year(Date)
        Worksheets(redemp).Cells(10, 4).Value = "Both"

        For i = issuer_row1 To issuer_rowL

    'CHANGES THE COPANY IN THE THE SHEET "Debt Redemptions Profile"
            Worksheets(redemp).Cells(6, 4).Value = Worksheets(auxil).Cells(i, 2).Value

    'FINDS THE ISSUER CODE IN AUXILIARRY SHEET
            issuerCode = Worksheets(auxil).Cells(i, 3).Value

    'COPIES RANGE WITH INFO DATA (COMPANY NAME, YEAR, ETC.)
            Worksheets(redemp).Range("B3:D11").Copy
            Worksheets("print").Cells(pasteRow, pasteCol).PasteSpecial xlPasteValues 'AndNumberFormats
            Worksheets("print").Cells(pasteRow, pasteCol).PasteSpecial xlPasteFormats

    'COPIES MATURITY PROFILE
            Worksheets(redemp).Range("F3:N25").Copy
            pasteRow = pasteRow + 10
            Worksheets(pdf).Cells(pasteRow, pasteCol).PasteSpecial xlPasteValues 'AndNumberFormats
            Worksheets(pdf).Cells(pasteRow, pasteCol).PasteSpecial xlPasteFormats

    **'COPIES THE CHART
            Worksheets(redemp).ChartObjects("Chart 6").CopyPicture
            pasteRow = pasteRow + 24
            Worksheets(pdf).Cells(pasteRow, pasteCol + 1).Activate
            Worksheets(pdf).Paste**

    'CALL A SUB WHICH FILTERS ALL MATURING DEBTS ACCORDING TO ISSUER CODE AND COPIES AND PASTE'S THE RESULT IN THE PRINT SHEET
            pasteRow = pasteRow + 22
            Call filterSheet(issuerCode, pasteRow, 2)
            Worksheets(pdf).Cells(pasteRow - 1, 1).Value = "Redemptions schedule 6 months ahead"
            Worksheets(pdf).Cells(pasteRow - 1, 1).Font.Bold = True

            pasteRow = pasteRow + 21


        Next i

    End Sub

Try this:

ActiveWorkbook.Worksheets(redemp).ChartObjects("Chart 6").CopyPicture
pasteRow = pasteRow + 24
ActiveWorkbook.Worksheets("print").Cells(pasteRow, 2).PasteSpecial

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM