EXCEL 2010 VBA 复制图表

Question

所以我对 excel 复制/粘贴的工作原理感到困惑。我有一个代码，它只是将一个图表复制为图片并将其粘贴到新工作表中。

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

如果我手动运行宏，它大部分时间都可以工作（打开多个 excel 文件） 如果我通过 VB 脚本运行宏并且没有打开其他 EXCEL 文件，它大部分时间都可以工作。 如果我通过 VB 脚本运行宏并且另一个 EXCEL 文件已打开，则代码在 20% 的时间和 80% 的时间都可以工作，我会收到“运行时错误 1004：工作表类的粘贴粘贴方法失败”

我做了很多研究，但还没有找到解决方案。任何帮助表示赞赏。

代码

    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

Answer 1

试试这个：

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