vba 更改工作表名称
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/14461155/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
changing a worksheet name
提问by Peter Smith
On my named active EXCEL sheet I have put a string with fewer than 32 characters in let's say cell A1.
在我命名的活动 EXCEL 工作表上，我在单元格中放置了一个少于 32 个字符的字符串A1。
I want to use the string in A1to rename the sheet. I have used VBA in the past but not for some time.
我想使用字符串 inA1来重命名工作表。我过去使用过 VBA，但有一段时间没有使用过。
I would be pleased if someone could suggest a macro that would do this when the cell A1 is clicked. Are there any characters that cannot be in A1 (I want ~ and underscore)?
如果有人可以建议在单击单元格 A1 时执行此操作的宏，我会很高兴。是否有任何不能在 A1 中的字符（我想要 ~ 和下划线）？
回答by Trace
Paste this code in the related Sheet object (VBA editor).
Note that you can also use an event such as double click.
On selecting cell "A1" of the active sheet, the sheet name will become the value contained by cell "A1".
将此代码粘贴到相关的 Sheet 对象（VBA 编辑器）中。
请注意，您还可以使用双击等事件。
在选择活动工作表的单元格“A1”时，工作表名称将成为单元格“A1”包含的值。
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim sSheet_Name As String
If Target = ActiveSheet.Range("A1") Then
sSheet_Name = ActiveSheet.Range("A1").Value
ActiveSheet.Name = sSheet_Name
End If
End Sub
Check out: Valid characters for Excel sheet names
回答by brettdj
For a complete process I would recommend
对于一个完整的过程，我会推荐
- Testing whether the sheet name already exists (to prevent an error)
- Cleansing the non-valid charcters before renaming the sheet
- Checking the new sheet name is less than 32 characters (but not empty)
- 测试工作表名称是否已经存在（防止出错）
- 在重命名工作表之前清除无效字符
- 检查新工作表名称是否少于 32 个字符（但不为空）
To use this code
要使用此代码
- right click your sheet tab
View Code- Copy and paste the code in
- Alt+ F11back to Excel
- 右键单击您的工作表标签
View Code- 将代码复制并粘贴到
- Alt+F11返回 Excel
The code is triggered by a right click on cell A1
该代码由右键单击单元格 A1 触发
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim rng1 As Range
Dim StrNew As String
Dim objRegex As Object
Dim blTest As Boolean
Dim ws As Worksheet
Set rng1 = Intersect(Range("A1"), Target)
If rng1 Is Nothing Then Exit Sub
StrNew = rng1.Value
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.Pattern = "[\/\\?\*\]\[]"
.Global = True
blTest = .test(StrNew)
StrNew = .Replace(StrNew, vbNullString)
End With
On Error Resume Next
Set ws = Sheets(StrNew)
On Error GoTo 0
If ws Is Nothing Then
If Len(StrNew) > 0 And Len(StrNew) < 32 Then
ActiveSheet.Name = StrNew
MsgBox "Sheet name updated to " & StrNew & vbNewLine & IIf(blTest, "Invalid characters were removed", vbNullString)
Else
MsgBox "Sheetname of " & StrNew & " is either empty or too long", vbCritical
End If
Else
MsgBox "Sheet " & StrNew & " already exists", vbCritical
End If
End Sub
