Excel VBA实现Spin button值递增并自动重命名新工作表求助

需求说明 #

我希望修改Spin button（数值调节钮）的值后创建新工作表：若当前活动工作表为2021 Aug，新工作表需为2021 Sep。单元格"AA3"和"AG3"已绑定Spin button的值，我希望新工作表名称取Spin button的值，或是"AA3"与"AG3"的拼接值。
核心需求如下：

• 新工作表对应的Spin button值自动递增1个月
• 工作表名称按照Spin button值、文本框值或者"AA3"+"AG3"的值命名，优先显示为Aug-2021、Sep-2021这类格式。
  

初始问题代码 #

初始版本可创建工作表，但无法更新调节钮值、命名错误：

Sub CreateSheet()

    ActiveSheet.Select
    Sheets(Sheets.Count).Copy After:=Sheets(Sheets.Count)
    
    If ActiveSheet.SpinButton2.Value <= 10 Then 
        ActiveSheet.SpinButton2.Value = SpinButton2.Value + 1
    ElseIf ActiveSheet.SpinButton2.Value = 11 Then
        ActiveSheet.SpinButton1.Value = ActiveSheet.SpinButton1.Value + 1 And ActiveSheet.SpinButton2.Value = 0
    End If

    ActiveSheet.name = SpinButton2.Value & SpinButton1.Value
    
End Sub

Private Sub SpinButton1_Change()

    SpinButton1.Max = 2999
    SpinButton1.Min = 1900
    SpinButton1.SmallChange = 1
    TextBox1.Value = SpinButton1.Value
        
    Call MakeDate(SpinButton1.Value, SpinButton2.Value)
End Sub

Private Sub SpinButton2_Change()
    Dim Mths As Variant

    SpinButton2.Max = 11
    SpinButton2.Min = 0
    Mths = Array("Jan", "Feb", "Mar", "Apr", "May", "June", "July", "Aug", "Sept", "Oct", "Nov", "Dec")
    TextBox2.Text = Mths(SpinButton2.Value)
        
    Call MakeDate(SpinButton1.Value, SpinButton2.Value)
        
End Sub

Private Sub MakeDate(sp1Val As String, sp2Val As String)
    Dim tempDate As Date

    tempDate = DateValue(sp1Val & "-" & sp2Val + 1 & "-" & 1)

    With Range("AE3")
        .NumberFormat = "yyyy"
        .Value = tempDate
    End With
     
    With Range("AA3")
         .NumberFormat = "mmm"
         .Value = tempDate
    End With

End Sub

优化后剩余问题 #

修改命名逻辑后，Feb-2021到Dec-2021的工作表可以正常生成且命名正确，修改的命名代码如下：

NewName = ActiveSheet.TextBox2.Text & "-" & ActiveSheet.TextBox1.Value 
ActiveSheet.Name = NewName

当前问题：复制Dec-2021工作表时会生成重复的Dec-2021表，Spin button的值没有变更。

修改后的完整代码：

Sub CreateSheet()
    
    ' Display a messagebox based on the response
    CarryOn = MsgBox("Do you want to create a new sheet? ", vbYesNo, "Continue?")
  
    If CarryOn = vbYes Then
  
        ActiveSheet.Select
        Sheets(Sheets.Count).Copy After:=Sheets(Sheets.Count)
    
        If ActiveSheet.SpinButton2.Value <= 10 Then 
            ActiveSheet.SpinButton2.Value = ActiveSheet.SpinButton2.Value + 1
        ElseIf ActiveSheet.SpinButton2.Value = 11 Then
            ActiveSheet.SpinButton2.Value = ActiveSheet.SpinButton2.Value - 11 And ActiveSheet.SpinButton1.Value = ActiveSheet.SpinButton1.Value + 1
        End If

        NewName = ActiveSheet.TextBox2.Text & "-" & ActiveSheet.TextBox1.Value
        ActiveSheet.Name = NewName
    End If
       
End Sub

问题排查与修复方案 #

核心错误点 #

1. VBA中And是逻辑运算符，不能用来拼接两条赋值语句，跨年逻辑的写法完全错误，导致年份和月份都不会更新
2. 调节钮值修改后未主动触发事件更新，文本框和单元格值可能停留在旧值，导致命名错误
3. 缺少重名校验，容易触发工作表命名冲突报错

修复后完整可运行代码 #

Sub CreateSheet()
    Dim CarryOn As VbMsgBoxResult
    Dim NewName As String
    
    CarryOn = MsgBox("Do you want to create a new sheet? ", vbYesNo, "Continue?")
    If CarryOn <> vbYes Then Exit Sub
    
    ' 复制当前活动工作表到末尾
    ActiveSheet.Copy After:=Sheets(Sheets.Count)
    Dim newSheet As Worksheet
    Set newSheet = ActiveSheet ' 锁定新生成的工作表，避免后续操作错位
    
    ' 递增调节钮值，修复跨年逻辑
    With newSheet
        If .SpinButton2.Value <= 10 Then
            .SpinButton2.Value = .SpinButton2.Value + 1
        Else ' 值为11时跨年
            .SpinButton2.Value = 0
            .SpinButton1.Value = .SpinButton1.Value + 1
        End If
        ' 强制触发更新，保证文本框和单元格值同步
        Call .SpinButton1_Change
        Call .SpinButton2_Change
        
        ' 生成工作表名，也可替换为.Range("AA3").Text & "-" & .Range("AE3").Text 取单元格值
        NewName = .TextBox2.Text & "-" & .TextBox1.Value
        ' 避免重名错误
        If Not SheetExists(NewName) Then
            .Name = NewName
        Else
            MsgBox "工作表 " & NewName & " 已存在，已生成未命名副本", vbExclamation
        End If
    End With
End Sub

' 辅助函数：判断工作表是否已存在
Function SheetExists(shtName As String, Optional wb As Workbook) As Boolean
    Dim sht As Worksheet
    If wb Is Nothing Then Set wb = ThisWorkbook
    On Error Resume Next
    Set sht = wb.Sheets(shtName)
    On Error GoTo 0
    SheetExists = Not sht Is Nothing
End Function

' 原有事件代码无需修改
Private Sub SpinButton1_Change()
    SpinButton1.Max = 2999
    SpinButton1.Min = 1900
    SpinButton1.SmallChange = 1
    TextBox1.Value = SpinButton1.Value
    Call MakeDate(SpinButton1.Value, SpinButton2.Value)
End Sub

Private Sub SpinButton2_Change()
    Dim Mths As Variant
    SpinButton2.Max = 11
    SpinButton2.Min = 0
    Mths = Array("Jan", "Feb", "Mar", "Apr", "May", "June", "July", "Aug", "Sept", "Oct", "Nov", "Dec")
    TextBox2.Text = Mths(SpinButton2.Value)
    Call MakeDate(SpinButton1.Value, SpinButton2.Value)
End Sub

Private Sub MakeDate(sp1Val As String, sp2Val As String)
    Dim tempDate As Date
    tempDate = DateValue(sp1Val & "-" & sp2Val + 1 & "-" & 1)
    With Range("AE3")
        .NumberFormat = "yyyy"
        .Value = tempDate
    End With
    With Range("AA3")
         .NumberFormat = "mmm"
         .Value = tempDate
    End With
End Sub

内容的提问来源于stack exchange，提问作者DEEK