☰

使用形狀複製貼上的 VBA 中出現不規則運行時錯誤

tag-icon • tag-icon microsoft-excel vba runtime-error shapes
使用形狀複製貼上的 VBA 中出現不規則運行時錯誤

我對 2 個 VBA 運行時錯誤感到好奇。奇怪的是：十分之九的程式碼運行得很好。但有時會出現以下 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

答案1

使用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

相關內容