Excel VBA工作簿打开代码求助：按单元格值另存后需补充执行代码

我明白你现在的困扰——谷歌搜了一堆方案都不管用，大概率是没找准触发时机对应的VBA事件，或者代码细节没处理好。先别慌，我给你梳理几个常见场景下的实现方式，都是基础易懂的代码，适合VBA新手上手。

首先先确认你提到的工作簿打开时自动执行的标准写法（可能你之前的代码有细节疏漏），这段代码必须放在ThisWorkbook模块里才能生效：

Private Sub Workbook_Open()
    ' 假设文件名存在于Sheet1的A1单元格，可根据实际修改工作表和单元格位置
    Dim saveFileName As String
    saveFileName = ThisWorkbook.Sheets("Sheet1").Range("A1").Value
    
    ' 先检查单元格是否为空，避免报错
    If saveFileName = "" Then
        MsgBox "指定的文件名单元格不能为空！"
        Exit Sub
    End If
    
    ' 检查工作簿是否已有保存路径（避免新工作簿未保存时路径为空）
    If ThisWorkbook.Path = "" Then
        MsgBox "请先手动保存当前工作簿，设置好保存路径！"
        Exit Sub
    End If
    
    ' 另存为.xlsx格式，若你的工作簿包含宏，需改为.xlsm并调整FileFormat参数
    ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & saveFileName & ".xlsx", FileFormat:=xlOpenXMLWorkbook
End Sub

下面是几种常见执行时机的对应代码：

1. 工作簿关闭时自动执行 #

同样把代码放在ThisWorkbook模块中：

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim saveFileName As String
    saveFileName = ThisWorkbook.Sheets("Sheet1").Range("A1").Value
    
    If saveFileName = "" Then
        MsgBox "文件名不能为空！"
        Cancel = True ' 阻止工作簿关闭，避免用户遗漏文件名
        Exit Sub
    End If
    
    If ThisWorkbook.Path = "" Then
        MsgBox "请先手动保存当前工作簿，设置好保存路径！"
        Cancel = True
        Exit Sub
    End If
    
    ' 另存为，若文件已存在会弹出覆盖提示，可按需添加自定义判断
    ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & saveFileName & ".xlsx", FileFormat:=xlOpenXMLWorkbook
End Sub

2. 点击按钮手动触发执行 #

步骤很简单：

1. 打开「开发工具」选项卡，点击「插入」→「表单控件按钮」，在工作表上画出按钮
2. 右键按钮选择「指定宏」，点击「新建」，然后把下面的代码粘贴进去：

Sub SaveAsByCellValue()
    Dim saveFileName As String
    saveFileName = ThisWorkbook.Sheets("Sheet1").Range("A1").Value
    
    If saveFileName = "" Then
        MsgBox "请先在Sheet1的A1单元格输入文件名！"
        Exit Sub
    End If
    
    If ThisWorkbook.Path = "" Then
        MsgBox "请先手动保存当前工作簿，设置好保存路径！"
        Exit Sub
    End If
    
    ' 自定义文件存在判断，避免默认的覆盖提示
    Dim filePath As String
    filePath = ThisWorkbook.Path & "\" & saveFileName & ".xlsx"
    If Dir(filePath) <> "" Then
        If MsgBox("文件已存在，是否覆盖？", vbYesNo) = vbNo Then
            Exit Sub
        End If
    End If
    
    ThisWorkbook.SaveAs Filename:=filePath, FileFormat:=xlOpenXMLWorkbook
    MsgBox "保存成功！"
End Sub

3. 文件名单元格变更时自动执行 #

比如当你修改Sheet1的A1单元格（存放文件名的单元格）后自动触发保存，这段代码要放在Sheet1模块里：

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 只监听A1单元格的内容变更
    If Not Intersect(Target, Me.Range("A1")) Is Nothing Then
        Dim saveFileName As String
        saveFileName = Target.Value
        
        If saveFileName = "" Then
            MsgBox "文件名不能为空！"
            Exit Sub
        End If
        
        If ThisWorkbook.Path = "" Then
            MsgBox "请先手动保存当前工作簿，设置好保存路径！"
            Exit Sub
        End If
        
        ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & saveFileName & ".xlsx", FileFormat:=xlOpenXMLWorkbook
    End If
End Sub

新手必看注意事项： #

• 代码要放在对应模块：工作簿事件（Open/BeforeClose）放ThisWorkbook，工作表事件放对应Sheet模块，按钮宏放标准模块（比如Module1）
• 若你的工作簿包含宏，保存格式要选.xlsm，同时把代码里的FileFormat:=xlOpenXMLWorkbook改为FileFormat:=xlOpenXMLWorkbookMacroEnabled

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