1004 ошибка приложения или объекта при именовании рабочих таблиц vba

Question

Я хотел бы переименовать рабочие листы в существующей рабочей книге.Это код, который я использую:

Dim LobArray As Variant
Dim TypeArray As Variant 
Dim g As String  

'Added during Edit of question.
Dim NoLobs As Long, NoTypes As Long
Dim l As Long, t As Long, s As Long
Dim SheetNames(100) As String
Dim SheetCountSpL As Long
Dim TmplSpl As Workbook
Set TmplSpl = ThisWorkbook
'-----------------------------

g = "_"
LobArray = Array("Lob1", "Lob2", "Lob3", "Lob4")
TypeArray = Array("ea", "pa", "inc")
NoLobs = UBound(LobArray) - LBound(LobArray) + 1
NoTypes = UBound(TypeArray) - LBound(TypeArray) + 1
For l = LBound(LobArray) To UBound(LobArray)
        For t = LBound(TypeArray) To UBound(TypeArray)
            SheetNames(l * NoLobs + t) = LobArray(l) & g & TypeArray(t)
            Next t
 Next l
SheetCountSpL = NoTypes * NoLobs
For s = 1 To SheetCountSpL
    TmplSpL.Worksheets(s).Activate
    TmplSpL.Worksheets(s).Name = SheetNames(s - 1)
  Next s

Когда я уменьшаю элементы в LobArray до 3, это работает.По сути, когда макрос должен переименовать более 9 листов, я получаю сообщение об ошибке, о котором упоминал в заголовке.

Answer 1

Это ошибка:

LobArray = четыре элемента.
TypeArray = три элемента.

1. l = 0,NoLobs = 4, t = 0 в первом цикле.
   • Первый внутренний цикл:
     0 * 4 + 0 = 0 = SheetNames(0) = LobArray(0) & TypeArray(0) = "Lob1_ea"
   • Второй внутренний цикл:
     0 * 4 + 1 = 1 = SheetNames(1) = .....
   • Третий внутренний цикл:
     0 * 4 + 2 = 2 = SheetNames(2) = .....
   • Четвертый внутренний цикл:
     Не выполняется, поскольку TypeArray имеет только 3 элемента.
     SheetNames (3) оставлено пустым, какрезультат

Этот код переименует ваши листы:

Public Sub Test()

    Dim LobArray As Variant
    Dim TypeArray As Variant
    Dim lobItm As Variant, typeItm As Variant
    Dim g As String, x As Long
    Dim RequiredSheetCount As Long

    g = "_"
    LobArray = Array("Lob1", "Lob2", "Lob3", "Lob4")
    TypeArray = Array("ea", "pa", "inc")

    RequiredSheetCount = (UBound(LobArray) + 1) * (UBound(TypeArray) + 1)

    If Worksheets.Count >= RequiredSheetCount Then
        For Each lobItm In LobArray
            For Each typeItm In TypeArray
                x = x + 1
                ThisWorkbook.Worksheets(x).Name = lobItm & g & typeItm
            Next typeItm
        Next lobItm
    Else
        MsgBox "The workbook needs at least " & RequiredSheetCount & " sheets to work properly."
    End If

End Sub

Answer 2

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

Sub CreateSheetsFromAList()


Dim MyCell As Range
Dim MyRange As Range

Set MyRange = Selection

For Each MyCell In MyRange

    Sheets.Add After:=Sheets(Sheets.Count) 'creates a new worksheet
    On Error Resume Next
    Sheets(Sheets.Count).Name = MyCell.Value 'renames the new worksheet
    If Err.Number = 1004 Then
    Application.DisplayAlerts = False
    ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True
    End If
    On Error GoTo 0

Next MyCell
End Sub