2017-09-21 67 views
3

我想要做的是從一張紙上覆制一堆作爲圖片的單元格並將其粘貼到另一張紙張的圖表對象中。以下是使用的代碼,在調試模式下使用時運行良好,但在正常運行時,我沒有看到圖表被粘貼到圖表中。VBA只能在調試模式下運行

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:要複製的宏將excel的一部分作爲屏幕截圖粘貼到圖表中可成功創建圖表,但在運行時無法填充圖像(F5),但在調試模式(F8)下完美工作。

+0

你確定沒有'activesheet'和'activeworkbook'的問題嗎? – FunThomas

+0

@FunThomas該代碼是我複製粘貼,並在調試模式下運行正常(F8) – StrikeR

+0

它爲我工作。你使用的是什麼優秀版本? – sktneer

回答

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 
相關問題