VBA 仅在 Debug模式下运行

Question

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

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 数到十亿，但还是没用。最后想检查图像是否粘贴到工作表的随机单元格中并且有效，但不能粘贴到图表对象中。

如果有人能帮助我找出图像无法粘贴的原因，我将不胜感激。

TL,DR:将 Excel 的一部分作为屏幕截图复制粘贴到图表中的宏成功创建了图表，但在运行 (F5) 时无法填充图像，但在 Debug模式 (F8) 下运行良好。

Answer 1

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

您可以尝试在 .Chart.Paste 之前添加 Select，这可能有助于在图表内粘贴。请参阅下面的代码，只需将这一行添加到您的原始代码中，这样您就快完成了。

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