Question

我想根据每张纸中的相同单元格重命名纸张。当我运行宏而不是预定义单元格时，我想使用输入框来定义要命名的工作表单元格。这就是我目前所拥有的 - 目前它仅适用于C8单元。

Sub RenameSheet()
Dim ws As Worksheet
For Each ws In Worksheets
    On Error Resume Next
    If Len(ws.Range("C8")) > 0 Then
        ws.Name = ws.Range("C8").Value
    End If 
    On Error GoTo 0
    If ws.Name <> ws.Range("C8").Value Then
        MsgBox ws.Name & " Was Not renamed, the suggested name was invalid"
    End If
Next 
End Sub

我认为这段代码会有所帮助，但我无法让它运行

Set CellID = Application.InputBox("Cell reference to label sheets", Type:=8)

有人对此有所帮助吗？

Answer 1

这应该适合你：

Sub RenameSheet()
    Dim ws As Worksheet, CellID As Range
    For Each ws In ThisWorkbook.Worksheets
        Set CellID = Application.InputBox("Cell reference to label sheets", Type:=8)
        Set CellID = ws.Cells(CellID.Row, CellID.Column)
        On Error Resume Next
        ws.Name = CellID
        On Error GoTo 0
        If ws.Name <> CellID.Value Then
            MsgBox ws.Name & " Was Not renamed, the suggested name was invalid"
        End If
    Next
End Sub

此代码会将您的范围设置两次，因为输入框采用ActiveSheet，因为在没有输入的情况下无法将工作表名称分配到输入范围。

因此，一旦您输入单元格地址，它将使用活动表格的输入范围的.Row和.Column属性，同时将它们分配到正确的工作表，因为我们没有在CellID.Row和CellID.Column。

中限定工作表

Answer 2

我建议进行以下更改。

此外，最好激活当前工作表，以便用户始终自动选择正确工作表上的单元格。

Option Explicit

Public Sub RenameSheet()
    Dim ws As Worksheet
    For Each ws In Worksheets

        ws.Activate 'so we automatically are on the correct sheet to select a range

        Dim CellID As Range
        Set CellID = Application.InputBox("Cell reference to label sheets", Type:=8)

        If CellID.Count > 1 Then 'check how many cells were selected
            MsgBox "Please select only one cell!", vbExclamation
            Exit Sub
        End If

        If Len(CellID.Value) > 0 Then
            On Error Resume Next
            ws.Name = CellID.Value
            'catch the error
            If Err.Number <> 0 Then MsgBox ws.Name & " Was Not renamed, the suggested name was invalid"
            On Error GoTo 0
        Else
            MsgBox ws.Name & " Was Not renamed, the suggested name was empty"
        End If
    Next ws
End Sub

选择地址一次的替代方法，并在每个工作表上使用相同的地址。

Option Explicit

Public Sub RenameSheet()
    Dim CellID As Range
    Set CellID = Application.InputBox("Cell reference to label sheets", Type:=8)

    If CellID.Count > 1 Then 'check how many cells were selected
        MsgBox "Please select only one cell!", vbExclamation
        Exit Sub
    End If

    Dim NameAddress As String
    NameAddress = CellID.Address(External:=False)

    Dim ws As Worksheet
    For Each ws In Worksheets
        If Len(ws.Range(NameAddress).Value) > 0 Then
            On Error Resume Next
            ws.Name = ws.Range(NameAddress).Value
            If Err.Number <> 0 Then MsgBox ws.Name & " Was Not renamed, the suggested name was invalid"
            On Error GoTo 0
        Else
            MsgBox ws.Name & " Was Not renamed, the suggested name was empty"
        End If
    Next ws
End Sub

VBA根据Inputbox单元格值重命名工作表

2 个答案: