VBA從單元格值自動填充選項卡名稱-有解無憂

我想首先說我是一名教師，并且幾乎沒有編碼經驗。我對如何在現有代碼中操作單元格值只有粗略的了解。我為我的學區創建了一個電子表格，以幫助教師簡化學生進度報告的創建程序。在 .xlsm 檔案中，我使用以下代碼根據同一選項卡中單元格“b1”的內容自動填充選項卡名稱。我在論壇上找到了這段代碼。它作業了幾年，但今年突然代碼不起作用。代碼失敗并顯示源單元格包含非法字符的 vba 代碼中劃定的訊息框：

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
    Set Target = Range("b1")
    If Target = "" Then Exit Sub
    On Error GoTo Badname
    ActiveSheet.Name = Left(Target, 31)
    Exit Sub
Badname:
    MsgBox "Please revise the entry in b1." & Chr(13) _
    & "It appears to contain one or more " & Chr(13) _
    & "illegal characters." & Chr(13)
    Range("b1").Activate
End Sub

可以修復此代碼嗎？excel 是否提供其他方法來從單元格值自動填充選項卡名稱？萬一這很重要，我用作選項卡名稱來源的單元格包含公式='class list'!B5。它從不同的選項卡中提取所需的源文本，目標是使通過公式傳輸的文本成為選項卡名稱的來源。有沒有辦法修改 VBA 代碼以直接從源選項卡中提取值？我可以理解是否是“b1”中的公式導致了問題？但對我來說是個謎，為什么在作業了幾年之后，問題才現在才顯現出來……

此 VBA 代碼的另一個問題是，它要求用戶在 VBA 代碼運行并更改選項卡名稱之前與選項卡中的單元格進行互動。是否可以在源單元格值更改后立即更改選項卡名稱？雖然不是絕對必要的，但這將是生活質量的一大改善。

非常感謝您的考慮，

埃里克

uj5u.com熱心網友回復：

重命名作業表時的驚喜

作業表的作業表模塊class list，例如Sheet2(class list)在專案瀏覽器中

調整目標作業表（您將要重命名的那個）代碼名稱 ( Sheet1)，該名稱不在 Project Explorer 中的括號中。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    RenameWorksheet Target, "B5", Sheet1
End Sub

標準模塊，例如Module1

Option Explicit

Sub RenameWorksheet( _
        ByVal Target As Range, _
        ByVal CellAddress As String, _
        ByVal dws As Worksheet)
    
    Dim sws As Worksheet: Set sws = Target.Worksheet
    
    Dim iCell As Range
    Set iCell = Intersect(Target, sws.Range(CellAddress))
    If iCell Is Nothing Then Exit Sub
    
    Dim OldName As String: OldName = dws.Name
    Dim NewName As String: NewName = CStr(iCell.Value)
    
    If StrComp(NewName, OldName, vbTextCompare) <> 0 Then
        ' 1.) Blank Cell
        If Len(NewName) = 0 Then Exit Sub ' the cell is blank
        ' 2.) 31 Character Limit
        If Len(NewName) > 31 Then
            MsgBox "Please revise the entry in cell 'B5'." & vbLf & vbLf _
                & "A maximum of 31 characters" & vbLf _
                & "is allowed for a sheet name.", vbCritical
            Exit Sub
        End If
        ' 3.) Reserved Name 'History'
        If StrComp(NewName, "History", vbTextCompare) = 0 Then
            MsgBox "Please revise the entry in cell 'B5'." & vbLf & vbLf _
                & "'" & NewName & "' is a reserved name " & vbLf _
                & "and cannot be used as a sheet name.", vbCritical
            Exit Sub
        End If
        ' 4.) Existence of a Sheet With the Same Name
        Dim sh As Object
        On Error Resume Next
            Set sh = ThisWorkbook.Sheets(NewName)
        On Error GoTo 0
        If Not sh Is Nothing Then
            MsgBox "Please revise the entry in cell 'B5'." & vbLf & vbLf _
                & "A sheet with the name '" & sh.Name & "'" & vbLf _
                & "already exists in this workbook.", vbCritical
            Exit Sub
        End If
    End If

    Dim ErrNumber As Long
    Dim ErrDescription As String
    
    ' Attempt to rename.
    On Error Resume Next
        dws.Name = NewName
        ErrNumber = Err.Number
        ErrDescription = Err.Description
    On Error Goto 0
    
    If ErrNumber <> 0 Then
        ' 5.) Illegal Characters: ':, \, /, ?, *, [ , ]'
        If Left(ErrDescription, 47) _
                = "You typed an invalid name for a sheet or chart." Then
            MsgBox "Please revise the entry in cell 'B5'." & vbLf & vbLf _
                & "It appears to contain one or more " & vbLf _
                & "illegal characters ("" : \ / ? * [ ] "")", vbCritical
            Exit Sub
        ' 6.) Unexpected error.
        Else
            MsgBox "Please revise the entry in cell 'B5'." & vbLf & vbLf _
                & "Run-time error '" & ErrNumber & "':" & vbLf _
                & ErrDescription, vbCritical
            Exit Sub
        End If
    End If

End Sub

uj5u.com熱心網友回復：

宏應在單元格更改時觸發，它是此鏈接中宏的一個版本：當單元格更改時運行宏

您的宏是否在上述鏈接中描述的作業表代碼中？我已獲取您的代碼并將其保存到空白作業簿中的作業表中。當我輸入 B1 時，它會更改作業表名稱。當我將 B1 鏈接到另一張表時，更改另一張表中的值并沒有觸發宏，即使它間接更改了 B1。即宏本身沒有問題你可以嘗試一些事情：

檢查類串列 B5 中是否沒有錯誤字符。
將 B1 更改為鏈接到班級串列的資料驗證下拉串列，這樣當您選擇要更改單元格的學生時。
洗掉 on 錯誤，使實際的錯誤描述變得可見，而不是宏的默認錯誤描述。

uj5u.com熱心網友回復：

將此代碼放在Worksheet_SelectionChange作業表的事件中運行并不是一個好主意，因為 - 正如事件名稱所暗示的那樣 - 在每個新的單元格選擇上都會觸發它。因此，如果用戶移動，例如，通過 10 個單元格，則作業表將被（重新）命名至少 9 次。這不是你想要發生的。如果您將代碼最終由用戶觸發（ALT F8，并運行代碼），或者作為最后的手段，為了使任務自動化，由SheetActivate事件（在作業簿代碼窗格中）觸發會更好。

然后你可以通過這種方式改進你的任務：

將此代碼放在標準模塊中：

Option Explicit
 
Sub fnRenameThisSheet()
    Call fnRenameTheSheet(ActiveSheet)
End Sub

Sub fnRenameAllSheets()
    Dim sh As Excel.Worksheet

    For Each sh In ThisWorkbook.Worksheets
        Call fnRenameTheSheet(sh)
    Next

End Sub

Sub fnRenameTheSheet(sh As Excel.Worksheet)
    Dim strSheetName As String
    Dim rngTarget As Excel.Range

    Set rngTarget = sh.Range("B1")
    If Len(rngTarget) = 0 Then Exit Sub
    strSheetName = fnReplaceIllegalChars(Left(rngTarget, 31), "_")
    On Error GoTo Badname 'in case of name alread in use for other sheet
    sh.Name = strSheetName
    
lblExit:
    Exit Sub
    
Badname:
    MsgBox "Please revise the entry in b1." & Chr(13) _
        & "It appears to contain one or more " & Chr(13) _
        & "illegal characters, or the name '" & strSheetName & _
        "' has already been assigned to another sheet. Check out." & Chr(13)
    Range("B1").Activate
End Sub


Function fnReplaceIllegalChars(strIn As String, strToThisChar As String) As String
    Dim strSpecialChars As String
    Dim i As Long
    strSpecialChars = "*:?/\[]"

    For i = 1 To Len(strSpecialChars)
        strIn = Replace(strIn, Mid$(strSpecialChars, i, 1), strToThisChar)
    Next

    fnReplaceIllegalChars = strIn
End Function

如果您真的希望它作為一種“自動化方式”，請使用作業簿事件SheetActivate，

將此代碼放在作業簿代碼窗格中：

Option Explicit

Private Sub Workbook_SheetActivate(ByVal sh As Object)
    Call fnRenameTheSheet(sh)
End Sub

要運行宏，除了“自動方式”，您可以按 ALT F8，然后選擇其中顯示的任務之一：fnRenameThisSheet重命名活動作業表，或fnRenameAllSheet一次重命名所有作業表。

轉載請註明出處，本文鏈接：https://www.uj5u.com/houduan/503715.html

標籤：擅长 vba

上一篇：VlookupVBAExcel

下一篇：將作業表傳遞給函式以自動調整列