Question

我要做的是将一堆单元格从一张纸张复制为图片并将其粘贴到另一张纸张中的图表对象中。以下是使用的代码，在调试模式下使用时运行正常，但是当我正常运行时，我看不到图像粘贴在图表中。

Sub copy_paste_KDT()
'
' copy_paste_KDT Macro
'

'
    Worksheets("KDT").Range("J12:AB37").CopyPicture Appearance:=xlScreen, Format:=xlPicture

    Dim wb_path As String
    wb_path = Application.ThisWorkbook.Path

    'Dim objCht As ChartObject
    'Set objCht = ActiveSheet.ChartObjects("KDT Rectangle")

    'If Not objCht Is Nothing Then
    If ActiveSheet.ChartObjects.Count > 0 Then
        ActiveSheet.ChartObjects("KDT Rectangle").Delete
    End If

    With Worksheets("profile")

        'Creating the Chart
        .ChartObjects.Add(690, 125, 550, 245).Name = "KDT Rectangle"

    End With

    If Range("B11").Value = 0 Then
        With Worksheets("profile")

            Application.ScreenUpdating = True
            'Application.Wait (Now + TimeValue("00:00:01"))

            With .ChartObjects("KDT Rectangle")
                .Chart.Paste
            End With

        End With
    End If   
End Sub

我还尝试了一些事情，例如在粘贴图像之前等待1到10秒但没有用。即使尝试将循环计数从1到10亿，也不再使用。最后想要检查图像是否粘贴在工作表的随机单元格中并且可以工作，但不是在图表对象中。

如果有人可以帮我弄清楚为什么图片没有粘贴，我将不胜感激。

TL，DR：宏将复制粘贴的一部分作为屏幕截图粘贴到图表中会成功创建图表，但在运行时无法填充图像（F5），但在调试模式（F8）下完美运行。

Answer 1

虽然我使用的是Excel 2010，但您的代码在我的测试中运行良好。

您可以尝试在Select之前添加.Chart.Paste，这有助于在图表中粘贴。请参阅下面的代码，只需将该行添加到原始代码中，因此您几乎就在那里。

Option Explicit

Sub copy_paste_KDT()
'
' copy_paste_KDT Macro
'

'
    Worksheets("KDT").Range("J12:AB37").CopyPicture Appearance:=xlScreen, Format:=xlPicture

    Dim wb_path As String
    wb_path = Application.ThisWorkbook.Path

    'Dim objCht As ChartObject
    'Set objCht = ActiveSheet.ChartObjects("KDT Rectangle")

    'If Not objCht Is Nothing Then
    If ActiveSheet.ChartObjects.Count > 0 Then
        ActiveSheet.ChartObjects("KDT Rectangle").Delete
    End If

    With Worksheets("profile")

        'Creating the Chart
        .ChartObjects.Add(690, 125, 550, 245).Name = "KDT Rectangle"

    End With

    If Range("B11").Value = 0 Then
        With Worksheets("profile")

            Application.ScreenUpdating = True
            'Application.Wait (Now + TimeValue("00:00:01"))

            With .ChartObjects("KDT Rectangle")
                .Select   'Just added this
                .Chart.Paste
            End With

        End With
    End If
End Sub

VBA仅在调试模式下运行

1 个答案: