Ошибка индекса VBA вне границ, но не при отладке

Question

У меня есть код, который берет данные с 2 разных листов, а также создает и выводит лист.Проблема в том, что если создается новая страница в данных, она должна сделать немного дополнительной информации и изменить место разрыва страницы.Когда я запускаю код с активной отладкой, чтобы увидеть, какая строка кода вызывает ошибку, он работает просто отлично.

Когда я запускаю его без отладки, я получаю сообщение об ошибке, что индекс находится внеграницы.

Я загрузил сам лист Excel в https://www.dropbox.com/s/pcl5zwuna8g7wrf/Test.xlsm?dl=0, но я просто не понимаю, почему он приводит к разным выходам в зависимости от того, проходит ли он или нет, так как он в любом случае однопоточный?

Это происходит при нажатии кнопки на четвертом листе.

Я загрузил код в pastebin по адресу: https://pastebin.com/rMwi7c7G

Public Function SeitenNr(rngZelle As Range) As Integer
  Dim wksHor As Integer, wksVert As Integer, SeiteNr As Integer
  Dim VertPb As Object, HortPb As Object
  Dim lngOrder As Long

  lngOrder = rngZelle.Parent.PageSetup.Order
  wksVert = rngZelle.Parent.VPageBreaks.Count + 1
  wksHor = rngZelle.Parent.HPageBreaks.Count + 1

  SeiteNr = 1
  For Each VertPb In rngZelle.Parent.VPageBreaks
    If VertPb.Location.Column > rngZelle.Column Then Exit For
    SeiteNr = SeiteNr + IIf(lngOrder = xlDownThenOver, wksHor, 1)
  Next VertPb
  For Each HortPb In rngZelle.Parent.HPageBreaks
    If HortPb.Location.Row > rngZelle.Row Then Exit For
    SeiteNr = SeiteNr + IIf(lngOrder = xlDownThenOver, 1, wksVert)
  Next HortPb
  SeitenNr = SeiteNr
End Function

Sub updateOutput()
    'Sheets("Print-Macro").UsedRange.ClearContents
    'Sheets("Print-Macro").Cells.UnMerge
    Application.DisplayAlerts = False
    Sheets("Print-Macro").Delete
    Application.DisplayAlerts = True
    Dim sheet As Worksheet
    Set sheet = Sheets.Add
    sheet.Name = "Print-Macro"

    Dim indexMain As Integer
    Dim currentIndex As Integer

    Dim artistName As String
    Dim artistNameLast As String
    Dim cellIndexOutput As Integer
    Dim birthdate As String
    Dim deathdate As String
    Dim originalPage As Integer
    Dim currentPage As Integer
    Dim latestPage As Integer
    Dim lastArtistPage As Integer
    Dim birthIndex As Integer
    Dim firstPageArtist As Integer

    indexMain = 2
    cellIndexOutput = 1
    Set f = ThisWorkbook.Worksheets("Print-Macro")

    Do
        Sheets("Print-Macro").Rows(cellIndexOutput).RowHeight = 15
        Set artistNameCell = Sheets("Was").Cells(indexMain, 1)
        If IsEmpty(artistNameCell.Value) Then
            Exit Do
        End If

        'Code only gets here if a valid entry is found. So create the output now
        artistName = artistNameCell.Value
        birthdate = ""
        deathdate = ""

        If artistNameLast <> artistName Then
            birthIndex = 2
            Do
                Dim tempName As String
                tempName = Sheets("Geboren").Cells(birthIndex, 1).Value
                If IsEmpty(Sheets("Geboren").Cells(birthIndex, 1).Value) Then
                    Exit Do
                End If

                If (tempName = artistName) Then
                    birthdate = Sheets("Geboren").Cells(birthIndex, 2).Value
                    deathdate = Sheets("Geboren").Cells(birthIndex, 3).Value
                End If
                birthIndex = birthIndex + 1
            Loop

            Sheets("Print-Macro").Range("A" & cellIndexOutput & ":" & "C" & cellIndexOutput).Merge
            Sheets("Print-Macro").Cells(cellIndexOutput, 1).Value = artistName & " (" & birthdate & "-" & deathdate & ")"
            Sheets("Print-Macro").Cells(cellIndexOutput, 1).Font.Underline = xlUnderlineStyleSingle
            lastArtistPage = Sheets("Print-Macro").HPageBreaks.Count
            firstPageArtist = cellIndexOutput
            cellIndexOutput = cellIndexOutput + 1
            Sheets("Print-Macro").Rows(cellIndexOutput).RowHeight = 15
        End If

        Sheets("Print-Macro").Rows(cellIndexOutput).RowHeight = 20

        Sheets("Print-Macro").Cells(cellIndexOutput, 2).Value = Sheets("Was").Cells(indexMain, 2).Value
        Sheets("Print-Macro").Cells(cellIndexOutput, 2).Font.Underline = xlUnderlineStyleNone

        Sheets("Print-Macro").Cells(cellIndexOutput, 3).Value = Sheets("Was").Cells(indexMain, 3).Value
        Sheets("Print-Macro").Cells(cellIndexOutput, 3).Font.Underline = xlUnderlineStyleNone

        cellIndexOutput = cellIndexOutput + 1
        Sheets("Print-Macro").Rows(cellIndexOutput).RowHeight = 15

        Sheets("Print-Macro").Cells(cellIndexOutput, 2).Value = Sheets("Was").Cells(indexMain, 4).Value
        Sheets("Print-Macro").Cells(cellIndexOutput, 2).Font.Underline = xlUnderlineStyleNone

        Sheets("Print-Macro").Cells(cellIndexOutput, 3).Value = Sheets("Was").Cells(indexMain, 5).Value
        Sheets("Print-Macro").Cells(cellIndexOutput, 3).Font.Underline = xlUnderlineStyleNone


        ' A page break happened in the last two lines it appears
        If lastArtistPage <> Sheets("Print-Macro").HPageBreaks.Count Then
            If cellIndexOutput = firstPageArtist + 2 Then
                f.Rows(firstPageArtist).PageBreak = xlPageBreakManual
            Else
                Set f = ThisWorkbook.Worksheets("Print-Macro")
                Dim lastBreak As Integer
                lastBreak = f.HPageBreaks(f.HPageBreaks.Count).Location.Row
                If lastBreak = cellIndexOutput Then
                    Sheets("Print-Macro").Range("A" & f.HPageBreaks(f.HPageBreaks.Count).Location.Row - 1).EntireRow.Insert
                    cellIndexOutput = cellIndexOutput + 1
                End If

                Sheets("Print-Macro").Range("A" & f.HPageBreaks(f.HPageBreaks.Count).Location.Row).EntireRow.Insert

                f.Rows(lastBreak).PageBreak = xlPageBreakManual

                Sheets("Print-Macro").Range("A" & lastBreak & ":" & "C" & lastBreak).Merge
                Sheets("Print-Macro").Range("A" & lastBreak & ":" & "C" & lastBreak).Value = "Noch " & artistName
                Sheets("Print-Macro").Range("A" & lastBreak & ":" & "C" & lastBreak).Font.Underline = xlUnderlineStyleSingle
                cellIndexOutput = cellIndexOutput + 1
            End If
        End If

        lastArtistPage = Sheets("Print-Macro").HPageBreaks.Count

        For i = 1 To f.HPageBreaks.Count
             Worksheets("Print-Macro").Cells(i, 4).Value = f.HPageBreaks(i).Location.Row
         Next

        latestPage = currentPage

        cellIndexOutput = cellIndexOutput + 1
        artistNameLast = artistName
        indexMain = indexMain + 1
    Loop
End Sub

Answer 1

Это известная ошибка Excel .

Обходной путь - выбрать достаточно дальнюю ячейку, например, нижнюю правую, перед доступом к коллекции HPageBreaks:

Dim previousActiveCell As Range
Set previousActiveCell = ActiveCell
f.Cells(f.Rows.Count, f.Columns.Count).Activate
Dim lastBreak As Integer
lastBreak = f.HPageBreaks(f.HPageBreaks.Count).Location.Row
previousActiveCell.Activate

Answer 2

Здесь происходит сбой:

lastBreak = f.HPageBreaks(f.HPageBreaks.Count).Location.Row

Но он делает это только тогда, когда indexMain = 58

После того, как ваш первый цикл do начинается сразу после этой строки:

    Set artistNameCell = Sheets("Was").Cells(indexMain, 1)

Поместите это:

    If indexMain = 58 Then Stop

Это переведет код в режим отладки, затем шаг за шагом пройдитесь по F8, и вы увидите, что он вылетает.

Если это не такдадим вам достаточно указаний, чтобы найти сообщение о проблеме, и я углублюсь в ваш код.