☰

도형 복사 붙여넣기를 사용하는 VBA의 불규칙한 런타임 오류

tag-icon • tag-icon microsoft-excel vba runtime-error shapes
도형 복사 붙여넣기를 사용하는 VBA의 불규칙한 런타임 오류

VBA 런타임 오류 2개에 대해 궁금합니다. 흥미로운 점은 10번 중 9번은 코드가 완벽하게 작동한다는 것입니다. 그러나 때때로 다음 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

관련 정보