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：工作表类的粘贴方法失败”

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

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

Answer 1

试试这个：

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

EXCEL 2010 VBA复制图

1 个答案: