Question

我已经创建了一个用于注册更改的模板。这些是该过程中的请求和进一步管理。我在此模板中有一个代码，始终将文件另存为excel宏启用的工作簿。此代码的问题在于我无法定义特定文件夹来保存文档。在所有情况下，将弹出“另存为”对话框，用户必须能够定义自己的文件名。我想为所有用户定义路径。有谁知道如何在此宏中添加文件位置（路径）以使其工作？

    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim FileNameVal As String
If SaveAsUI Then
    FileNameVal = Application.GetSaveAsFilename(, "Excel Macro-Enabled Workbook (*.xlsm), *.xlsm")
    Cancel = True
    If FileNameVal = "False" Then 'User pressed cancel
        Exit Sub
    End If
    Application.EnableEvents = False
        If Right(ThisWorkbook.Name, 5) <> ".xlsm" Then
            ThisWorkbook.SaveAs Filename:=FileNameVal, FileFormat:=xlOpenXMLWorkbookMacroEnabled
        Else
            ThisWorkbook.SaveAs Filename:=FileNameVal, FileFormat:=xlOpenXMLWorkbookMacroEnabled
        End If
    Application.EnableEvents = True
End If
End Sub

提前致谢。

亲切的问候， Remco H.

Answer 1

如果您希望生成唯一的文件名，可以使用以下函数：

Function NextFileName(basename As String) As String
    Dim followup As Integer
    Dim pathname As String
    pathname = "C:\Temp\Temp\" ' Include the trailing path separator so that we don't have to do it later
    followup = 1
    Do
        NextFileName = pathname & basename & "-" & followup & ".xlsm"
        If Dir(NextFileName) = "" Then Exit Function
        followup = followup + 1
    Loop
End Function

然后您可以从主代码中将其称为

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim FileNameVal As String
    If SaveAsUI Then  ' <-- Exclude the IF statement if you want EVERY save to have a new follow up number
                      '     rather than just "Save As" saves
        Application.EnableEvents = False
        'Generate the filename
        FileNameVal = NextFileName(Format(Now, "yymmdd"))
        ThisWorkbook.SaveAs Filename:=FileNameVal, FileFormat:=xlOpenXMLWorkbookMacroEnabled
        'Maybe advise the user that the save has happened, and where it went to
        MsgBox "Spreadsheet saved as " & FileNameVal
        Cancel = True
        Application.EnableEvents = True
    End If
End Sub

excel vba saveasui文件路径

1 个答案: