如何使用AddIn将打开的工作簿保存至同目录、同扩展名、不同名称

原代码问题根因 #

• 代码中ThisWorkbook在xlam加载项运行时指向加载项本身，而非用户正在编辑的工作簿，导致获取的路径为加载项存储路径，甚至会误保存加载项文件
• 硬编码.xlsm作为保存后缀，无法适配其他Excel格式文件

修复后代码 #

Sub saveas()
    Dim targetWB As Workbook
    Dim pathONLY As String, wbname As String, fileExt As String
    Dim dotPos As Integer
    
    ' 绑定当前处于活动状态的用户工作簿
    Set targetWB = ActiveWorkbook
    
    ' 避免操作到加载项自身
    If targetWB.IsAddin Then Exit Sub
    
    ' 处理未保存过的新建工作簿，默认保存到系统文档目录
    If targetWB.Path = "" Then
        pathONLY = Environ("USERPROFILE") & "\Documents\"
    Else
        ' 读取原工作簿所在的目录作为保存路径
        pathONLY = targetWB.Path & "\"
    End If
    
    ' 提取原工作簿的文件扩展名
    dotPos = InStrRev(targetWB.Name, ".")
    If dotPos > 0 Then
        fileExt = Right(targetWB.Name, Len(targetWB.Name) - dotPos + 1)
    Else
        ' 无扩展名的特殊情况默认使用xlsm格式，可按需修改
        fileExt = ".xlsm"
    End If
    
    ' 自定义保存的新文件名
    wbname = "NewFile"
    
    On Error Resume Next
    ' 保存时沿用原工作簿的文件格式，避免兼容问题
    targetWB.SaveAs Filename:=pathONLY & wbname & fileExt, FileFormat:=targetWB.FileFormat
    On Error GoTo 0
    
    ' 可选：保存失败时弹窗提示
    If Err.Number <> 0 Then
        MsgBox "保存失败，错误信息：" & Err.Description, vbExclamation
    End If
End Sub

核心修改说明 #

• 所有操作对象改为用户当前编辑的活动工作簿，添加加载项自身判断避免误操作
• 直接读取目标工作簿的原生路径属性，不需要手动拆分路径，稳定性更高
• 自动识别原文件扩展名，同时适配未保存的新建工作簿场景
• 保存时指定与原文件一致的文件格式参数，避免格式不兼容报错

内容的提问来源于stack exchange，提问作者phat tran Quang