ข้อผิดพลาดรันไทม์ผิดปกติใน VBA โดยใช้การคัดลอกแปะรูปร่าง

ฉันอยากรู้เกี่ยวกับข้อผิดพลาดรันไทม์ 2 VBA สิ่งที่อยากรู้คือ: 9 จาก 10 ครั้งรหัสทำงานได้อย่างสมบูรณ์แบบ แต่ในบางครั้งหนึ่งใน 2 ข้อผิดพลาดรันไทม์ต่อไปนี้จะปรากฏขึ้นเป็นครั้งคราว

Run-Time error '1004': Paste method of Picture object failed

Run-time error -214724809 (80070057): The index into the specified collection is out of bounds.

ฉันไม่สามารถระบุการพึ่งพาใด ๆ เมื่อมันจะหรือไม่ปรากฏ

นี่คือสิ่งที่ฉันทำ:

1. คลิกที่ปุ่มใน Excel ซึ่งจะทำตามขั้นตอนต่อไปนี้ผ่าน VBA
2. สร้างแผ่นงานใหม่ 'Detailinterview'
3. คัดลอกโลโก้จากแผ่นข้อมูล
4. วางลงในแผ่นงาน 'Detailinterview'

นี่คือรหัสของฉัน

Public Const DATA = "Data"
Public Const DETAILINTERVIEW = "Detailinterview"

Public Sub DoMagic()
  Dim logo As Shape

  'Some other code

  For Each logo In Sheets(DATA).Shapes
    If logo.Name = "MY_LOGO" Then
        logo.Copy
        Sheets(DETAILINTERVIEW).Pictures.Paste ' runtime error 1004
    End If
  Next

  ' Hint: Sheet DETAILINTERVIEW contains only 1 shape: MY_LOGO
  Set logo = Worksheets(DETAILINTERVIEW).Shapes(1) 'runtime error -214724809 
  If Not logo Is Nothing Then
    logo.IncrementLeft 580
    logo.IncrementTop 4
  End If
End Sub

ทำไม VBA ถึงทำงานล้มเหลว เหตุใดจึงเกิดการขัดข้องเป็นครั้งคราวเท่านั้น ฉันจะแก้ไขได้อย่างไร

ขอบคุณล่วงหน้า!

ตามที่ร้องขอนี่คือรหัสที่เหลือ:

Public Const DATA = "Data"
Public Const DETAILINTERVIEW = "Detailinterview"

Public Sub DoMagic()
    Dim logo As Shape
    Dim i As Long
    Dim sheetExists As Boolean

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    For i = 1 To Sheets.Count
        If Sheets(i).Name = DETAILINTERVIEW Then
          sheetExists = True
          Debug.Print MsgBox("A worksheet 'Detailinterview' exists already!", vbOKOnly)  
          Exit Sub
        End If
    Next i

    Worksheets("Datenblatt_Template").Copy after:=Worksheets(QUESTION_SELECTION)
    Worksheets("Datenblatt_Template (2)").Visible = True
    Worksheets("Datenblatt_Template (2)").Activate
    ActiveSheet.Name = DETAILINTERVIEW
    Worksheets(DETAILINTERVIEW).Columns("I:I").ColumnWidth = 1
    Worksheets(DETAILINTERVIEW).Columns("K:K").ColumnWidth = 33
    Worksheets(DETAILINTERVIEW).Columns("M:M").ColumnWidth = 17
    Worksheets(DETAILINTERVIEW).Columns("O:O").ColumnWidth = 3

    ActiveWindow.DisplayGridlines = False
    ActiveWindow.DisplayHeadings = False
    ThisWorkbook.Worksheets(DETAILINTERVIEW).Range("A:H").EntireColumn.Hidden = True

    ThisWorkbook.Worksheets("Templates").Range("T_HEADER").Copy
    ThisWorkbook.Worksheets(DETAILINTERVIEW).Activate
    ThisWorkbook.Worksheets(DETAILINTERVIEW).Rows("1:1").Select
    ThisWorkbook.ActiveSheet.Paste

    ThisWorkbook.Worksheets("Templates").Range("T_MASTER_HEADER").Copy
    ThisWorkbook.Worksheets(DETAILINTERVIEW).Activate
    ThisWorkbook.Worksheets(DETAILINTERVIEW).Rows("2:2").Select
    ThisWorkbook.ActiveSheet.Paste

    Worksheets(DETAILINTERVIEW).Range("J2").Value = Range(START & "!C20") & " - " & Range(START & "!C21") & " - " & Range(START & "!C22")

    For Each logo In Sheets(DATA).Shapes
        If logo.Name = "MY_LOGO" Then
             logo.Copy
             Sheets(DETAILINTERVIEW).Pictures.Paste ' runtime error 1004
        End If
    Next

    ' Hint: Sheet DETAILINTERVIEW contains only 1 shape: MY_LOGO
    Set logo = Worksheets(DETAILINTERVIEW).Shapes(1) 'runtime error -214724809 
    If Not logo Is Nothing Then
        logo.IncrementLeft 580
        logo.IncrementTop 4
    End If

    ' Some more Magic
End Sub

การใช้ Select, Activate ฯลฯ เป็นสิ่งที่อันตราย คุณควรมีคุณสมบัติวัตถุของคุณกับผู้ปกครองแทน อดีต

Sheets(1).Range("A1").value = 1

ดีกว่า

Sheets(1).Activate
Range("A1").Select
Selection.Value = 1

ฉันล้างรหัสของคุณสักหน่อย:

Option Explicit

Public Const DATA = "Data"
Public Const DETAILINTERVIEW = "Detailinterview"

Public Sub DoMagic()
    Dim logo As Shape
    Dim i As Long

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    For i = 1 To Sheets.Count
        If Sheets(i).Name = DETAILINTERVIEW Then
          Debug.Print MsgBox("A worksheet " & DETAILINTERVIEW & " exists already!", vbOKOnly)
          Exit Sub
        End If
    Next i

Dim ws As Worksheet
With ThisWorkbook
    .Worksheets("Datenblatt_Template").Copy after:=.Worksheets(.Worksheets.Count)
    Set ws = .Worksheets(.Worksheets.Count)
End With
With ws
    .Name = DETAILINTERVIEW
    .Columns("I:I").ColumnWidth = 1
    .Columns("K:K").ColumnWidth = 33
    .Columns("M:M").ColumnWidth = 17
    .Columns("O:O").ColumnWidth = 3

    ActiveWindow.DisplayGridlines = False
    ActiveWindow.DisplayHeadings = False
    .Range("A:H").EntireColumn.Hidden = True

    ThisWorkbook.Worksheets("Templates").Range("T_HEADER").Copy Destination:=.Range("A1")
    ThisWorkbook.Worksheets("Templates").Range("T_MASTER_HEADER").Copy Destination:=.Range("A2")

    '***************************
    'I can't get the next line to run because Start is uninitialized 
    '.Range("J2").Value = Range(Start & "!C20") & " - " & Range(Start & "!C21") & " - " & Range(Start & "!C22")
    '****************************

    For Each logo In Sheets(DATA).Shapes
        If logo.Name = "MY_LOGO" Then
             logo.Copy
             .Pictures.Paste
             .Shapes(1).IncrementLeft 580
             .Shapes(1).IncrementTop 4
             Exit For
        End If
    Next
    If .Shapes.Count < 1 Then Debug.Print "Logo not found"
End With
    ' Some more Magic
End Sub