VBA код, чтобы переименовать лист или показать ошибку

Question

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

Номер находится в ячейке D10 на листе.

          For Each Sheet In ThisWorkbook.Sheets
            If Sheet.Name = Range("D10") Then
                MsgBox ("ERROR: This Acct No has already been formulated")
                NewName = InputBox("Please Rename:")
                ActiveSheet.Name = NewName
            ElseIf Sheet.Name <> Range("D10") Then
                ActiveSheet.Name = Range("D10")

            End If
            Next Sheet

Я ожидаю, что появится мое собственное сообщение, но в Excel просто появится собственное сообщение об ошибке.

Answer 1

попробуйте это:

Dim MyDuplicate as boolean

MyDuplicate = False

For Each Sheet In ThisWorkbook.Sheets
    If Sheet.Name = Range("D10") Then
        MsgBox ("ERROR: This Acct No has already been formulated")
        NewName = InputBox("Please Rename:")
        ActiveSheet.Name = NewName
        MyDuplicate = True
        Exit for
    End If
Next Sheet

If MyDuplicate = False then ActiveSheet.Name = Range("D10")

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

Answer 2

Вместо того, чтобы зацикливать каждый лист на наличие дубликатов, создайте функцию, которая возвращает логическое значение. Эта функция будет иметь ошибку, если лист не существует, и не будет ошибки, если лист существует. Мы проверяем эту ошибку и возвращаем True, если лист существует, False в противном случае.

Option Explicit

Private Function SheetExists(wsName As String, Optional wb As Workbook = Nothing) As Boolean
Dim ws As Worksheet
On Error Resume Next
If wb Is Nothing Then
    Set ws = Worksheets(wsName)
Else
    Set ws = wb.Worksheets(wsName)
End If
SheetExists = (Err.Number = 0)
End Function

И тогда ваш код может быть заменен следующим, который будет вызывать InputBox столько раз, сколько необходимо, чтобы пользователь не мог ввести другую недопустимую / дублирующую запись. Для этого я объединил текст MsgBox и InputBox, и кажется, что нет необходимости выдавать пользователю два запроса, когда мы можем использовать InputBox для обоих информировать и запрашивать новый ввод.

Dim ws as Worksheet
Dim newName as String
Set ws = ActiveSheet   ' would be better to avoid this, but OK.
newName = Range("D10").Value
While SheetExists(newName, ws.Parent)
    newName = InputBox("ERROR: This Acct No has already been formulated!" & vbCrLf & vbCrLf & _
                    newName & " already exists! Enter new name:")
Wend
ws.Name = newName

Answer 3

Option Explicit

Sub TestMe()

    Dim wks As Worksheet
    Worksheets.Add After:=ActiveSheet

    For Each wks In ThisWorkbook.Worksheets
        With wks
            If .Name = .Range("D10") Then
                MsgBox ("ERROR: This Acct No has already been formulated")
                .Name = InputBox("Please Rename:")
            ElseIf .Name <> .Range("D10") Then
                If Trim(.Range("D10")) = "" Then
                    .Range("D10") = Replace(Replace(Now, ":", "_"), "/", "_")
                    Application.Wait Now + #12:00:02 AM#
                End If
                .Name = .Range("D10").Value
            End If
        End With
    Next wks

End Sub

Это некоторая идея, как это сделать, избегая Activate и Select, как указано в Как избежать использования Select в Excel VBA (По иронии судьбы я ушел Worksheets.Add After:=ActiveSheet)

Партия .Range("D10") = Replace(Replace(Now, ":", "_"), "/", "_") записывает текущую дату и время, следя за тем, чтобы они всегда были уникальными, ожидая 2 секунды на следующей строке - Application.Wait Now + #12:00:02 AM#