excel - 在另存为对话框中选择目录

Question

如何添加Save As对话框代码以便用户可以选择目录？

用户应该能够选择文件夹C或者F并且不应该能够更改文件名test

Sub Saved()
    Application.DisplayAlerts = False
    Worksheets("test").Copy
    'there is now a new active workbook
    With ActiveWorkbook
        'save it
        .SaveAs Filename:="test", FileFormat:=xlWorkbookDefault, Password:=1234, writerespassword:=12345
        'optionally close it
        .Close savechanges:=False
    End With
End Sub

标签： excelvba

Answer 1

其实很简单。

尝试这个

Sub Saved()
    Dim Ret As Variant
    Dim NewFileName As String
    
    '~~> Let user select folder
    Ret = BrowseForFolder
      
    '~~> Check if user selected a folder
    If Ret = False Then
        MsgBox "Please select a folder"
        Exit Sub
    End If
        
    If Right(Ret, 1) <> "\" Then Ret = Ret & "\"
      
    '~~> Predecide the file name so user cannot change
    NewFileName = Ret & "Text.xlsx"
        
    'MsgBox NewFileName
        
    Application.DisplayAlerts = False
        
    Worksheets("test").Copy

    'there is now a new active workbook
    With ActiveWorkbook
        'save it
        .SaveAs FileName:=NewFileName, FileFormat:=xlWorkbookDefault, _
                Password:=1234, writerespassword:=12345
        'optionally close it
        .Close savechanges:=False
    End With
End Sub

'~~> Function to choose the folder
Function BrowseForFolder(Optional OpenAt As Variant) As Variant
    Dim ShellApp As Object
     
    Set ShellApp = CreateObject("Shell.Application"). _
        BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
     
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0
     
    Set ShellApp = Nothing
     
    Select Case Mid(BrowseForFolder, 2, 1)
        Case Is = ":"
            If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
        Case Is = "\"
            If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
        Case Else
            GoTo Invalid
    End Select
     
    Exit Function
Invalid:
    BrowseForFolder = False
End Function