首页 > 解决方案 > VBA不重命名新工作表

问题描述

下面的代码应该添加一个新工作表,然后从输入框中为其命名。我已经经历了几次迭代,但无法让它发挥作用。

Option Explicit

Dim oWS as Worksheet, sName as String

Again:
    sName = Inputbox ("Enter Sheet Name")
    If sName = vbNull Then Exit Sub

For Each oWs in Worksheets
    If LCase (sName) = LCase (oWS.Name) Then GoTo Again
Next oWS

Set oWS = Worksheets.Add(,ActiveSheet)
End Sub

标签: excelvba

解决方案


我会使用,Application.InputBox因为如果为空,它会返回 false。在Goto你的代码中包含语句有点像在你的房子脏的时候邀请人们过来。最后,添加了一些代码来处理无效的工作表名称。

Sub AddWorksheet()
    Dim result As Variant
    Dim ws As Worksheet

    Do
        result = Application.InputBox(Prompt:="Enter Sheet Name", Title:=IIf(Len(result) = 0, "Create Worksheet", result & " - Exists"), Type:=2)
        If result = False Then Exit Sub
    Loop Until Not WorksheetExists(result)

    Set ws = ThisWorkbook.Worksheets.Add

    On Error Resume Next
    ws.Name = result
    If Err.Number <> 0 Then
        Application.DisplayAlerts = False
        ws.Delete
        Application.DisplayAlerts = True
        If MsgBox("Try Again?", vbYesNo, "Invalid Name") = vbYes Then AddWorksheet
        Exit Sub
    End If
    On Error GoTo 0

End Sub

Function WorksheetExists(result As Variant) As Boolean
    Dim ws As Worksheet
    For Each ws In Worksheets
        If LCase(result) = LCase(ws.Name) Then
            WorksheetExists = True
            Exit Function
        End If
    Next
End Function

推荐阅读