Ошибка времени выполнения '1004': Определенная приложением или объектная ошибка при многократном использовании объекта «range»

Question

Я пытаюсь сделать автоматизированный шаблон с VBA, и этот код, кажется, работает нормально, когда я вхожу в низкое количество «страниц», но когда я вводил в подсказки что-то вроде следующего: это дает мне ошибку времени выполнения 1004: 14 страниц: 41, 26, 19, 28, 26, 28, 17, 26, 21 , 19, 19, 10, 23, 28.

Public TitleSize As Integer 
Public MostValves() As Integer 
Public TotalValves As Integer 
Public TitleBlockSize As Integer 

Function ConvertToLetter(iCol As Integer) As String 
    Dim iAlpha As Integer 
    Dim iRemainder As Integer 
    iAlpha = Int(iCol/27) 
    iRemainder = iCol - (iAlpha * 26) 
    If iAlpha > 0 Then 
     ConvertToLetter = Chr(iAlpha + 64) 
    End If 
    If iRemainder > 0 Then 
     ConvertToLetter = ConvertToLetter & Chr(iRemainder + 64) 
    End If 
End Function 

Sub ManualValve() 

'On Error GoTo ErrHandler 
'On Error Resume Next 

Worksheets(1).Activate 
ActiveSheet.Name = "Valve List" 
ActiveSheet.Cells.Clear 

PnIDPage = InputBox("How many pages are on your P&ID?") 
'Values for Number of Pages: 14 

Dim i As Integer 

TotalValves = 0 

ReDim MostValves(PnIDPage) 

For i = 0 To PnIDPage - 1 

    ValveCount = InputBox("How many valves are on page " & i + 1 & " ?") 
'Values for valves: 41, 26, 19, 28, 26, 28, 17, 26, 21, 19, 19, 10, 23, 28 
    If IsNumeric(ValveCount) Then 
     MostValves(i) = ValveCount 
     TotalValves = TotalValves + ValveCount 
    Else 
     MsgBox ("You did not enter a valid number") 
     'GoTo ErrHandler 
    End If 
Next i 

Dim Title As Variant 

Response = MsgBox(prompt:="Do you want to use the default titleblock? (Count, Valve, Module, Note)", Buttons:=vbYesNo) 

If Response = vbYes Then 
    Title = Array("Count", "Valve", "Module", "Note") 
    TitleSize = UBound(Title, 1) - LBound(Title, 1) + 1 
Else 
    Title = Array("Count", "Valve", "Module") 
    TitleSize1 = UBound(Title, 1) - LBound(Title, 1) + 1 
    XtraCol = InputBox("How many extra columns would you like to add?") 
    ReDim Preserve Title(XtraCol + TitleSize1 - 1) 
    TitleSize = UBound(Title, 1) - LBound(Title, 1) + 1 
     For i = TitleSize1 + 1 To TitleSize 
      XtraTitle = InputBox("Extra Title " & i & "?") 
      Title(i - 1) = XtraTitle 
     Next i 
End If 

Dim TitleBlock As Variant 

TitleBlock = Array("Project Number", "Project Name", "By", "Rev", "Date") 
TitleBlockSize = UBound(TitleBlock, 1) - LBound(TitleBlock, 1) + 1 
Range(ConvertToLetter(1) & "1:" & ConvertToLetter(1) & TitleBlockSize) = Application.Transpose(TitleBlock) 

Dim Maximum As Integer 
Dim ValveNum() As Integer 
Dim TempSize As Integer 

TempSize = 1 
Maximum = WorksheetFunction.Max(MostValves) + 1 

For i = 0 To PnIDPage - 1 
    Do Until MostValves(i) <> 0 
     i = i + 1 
    Loop 

    ReDim ValveNum(MostValves(i)) 

    For j = 0 To MostValves(i) 
     ValveNum(j) = j + 1 
    Next j 
     MsgBox TempSize 
     If i Mod 2 = 0 Then 
      Worksheets(1).Range(ConvertToLetter(TempSize) & TitleBlockSize + 2 & ":" & ConvertToLetter(TempSize + TitleSize - 1) & Maximum + TitleBlockSize).Interior.ColorIndex = 42 
     Else 
'This is where I encounter the run-time error 
      Worksheets(1).Range(ConvertToLetter(TempSize) & TitleBlockSize + 2 & ":" & ConvertToLetter(TempSize + TitleSize - 1) & Maximum + TitleBlockSize).Interior.ColorIndex = 43 
     End If 

     Worksheets(1).Range(ConvertToLetter(TempSize) & TitleBlockSize + 2 & ":" & ConvertToLetter(TempSize) & CStr(MostValves(i) + 1 + TitleBlockSize)). _ 
     Resize(MostValves(i), 1) = Application.Transpose(ValveNum) 
     Worksheets(1).Range(ConvertToLetter(TempSize + 2) & TitleBlockSize + 2 & ":" & ConvertToLetter(TempSize + 2) & CStr(MostValves(i) + 1 + TitleBlockSize)) = "00" & CStr(i + 1) 
     Worksheets(1).Range(ConvertToLetter(TempSize) & TitleBlockSize + 1 & ":" & ConvertToLetter(TempSize + TitleSize - 1) & TitleBlockSize + 1) = Title 
     TempSize = TempSize + TitleSize 
     Worksheets(1).Range(ConvertToLetter(TempSize - 1) & TitleBlockSize + 1 & ":" & ConvertToLetter(TempSize - 1) & Maximum + TitleBlockSize). _ 
     Borders(xlEdgeRight).Weight = xlMedium 
    Next i 

    Cells(1, 4) = "Total Valve Count" 
    Cells(1, 5) = TotalValves 
    Range("A1:" & ConvertToLetter(TempSize) & Maximum + TitleBlockSize).HorizontalAlignment = xlCenter 
    Range("A1:A" & TitleBlockSize).HorizontalAlignment = xlLeft 
    Columns("A:" & ConvertToLetter(TempSize)).AutoFit 
    Range("A1:" & ConvertToLetter(TempSize) & TitleBlockSize + 1).Font.Bold = True 
    Range("A" & TitleBlockSize + 1 & ":" & ConvertToLetter(TempSize - 1) & TitleBlockSize + 1).Interior.ColorIndex = 1 
    Range("A" & TitleBlockSize + 1 & ":" & ConvertToLetter(TempSize - 1) & TitleBlockSize + 1).Font.Color = vbWhite 
    Range("A" & Maximum + TitleBlockSize & ":" & ConvertToLetter(TempSize - 1) & Maximum + TitleBlockSize). _ 
     Borders(xlEdgeBottom).Weight = xlMedium 

'ErrHandler: 
    'MsgBox "An error has occurred. The macro will end." 

End Sub 

Answer 1

проблема не зависит от вашего Valve, но на вашей ConvertToLetter функции. В самом деле, в какой-то момент происходит ошибка, потому что функция возвращает недопустимое письмо диапазон:

input: iCol = 53 
return: "A[" 

Очевидно, что при попытке вызвать Range("A[2"), это вызывает исключение.

Кода внутри функции не солидно, потому что преобразует число в письмо с:

ConvertToLetter = Chr(iAlpha + 64) 

Chr() функция возвращает значение, связанное с индексом из коллекции символов, которая является уникальным списком символов и не может как вы пытаетесь сделать там. я бы просто заменить ConvertToLetter функции с более твёрдым, например, следующим:

Function ConvertToLetter(iCol As Integer) As String 
    Dim vArr 
    vArr = Split(Cells(1, iCol).Address(True, False), "$") 
    ConvertToLetter = vArr(0) 
End Function 

... который был любезно предоставленного brettdj в одном из его драгоценных answers (не забудьте дать ему верх для этого куска золота;).

P.s. обратите внимание, что это объясняет также, почему низкое число не вызвало бы исключения: пока число невелико, вашей функции не нужно добавлять вторую букву к выходу, чтобы она оставалась непротиворечивой. Но как только это нужно сделать, CRASH;)

Используйте вышеуказанную функцию, это безопаснее, потому что он просто извлекает адрес Range из объекта Cells. Ваш код будет работать отлично, как только вы замените старую функцию на новую.