Question

您好我只是将此代码嵌入到我的vba宏中，但是当我使用此宏时如何更改默认目录...例如当我点击它时会转到D：/ myfolder

我在谷歌找到了这段代码：

Sub Copy_ActiveSheet_2()
'Working in Excel 2000-2013
Dim fname As Variant
Dim NewWb As Workbook
Dim FileFormatValue As Long

'Check the Excel version
If Val(Application.Version) < 9 Then Exit Sub
If Val(Application.Version) < 12 Then

    'Only choice in the "Save as type" dropdown is Excel files(xls)
    'because the Excel version is 2000-2003
    fname = Application.GetSaveAsFilename(InitialFileName:="", _
    filefilter:="Excel Files (*.xls), *.xls", _
    Title:="This example copies the ActiveSheet to a new workbook")

    If fname <> False Then
        'Copy the ActiveSheet to new workbook
        ActiveSheet.Copy
        Set NewWb = ActiveWorkbook

        'We use the 2000-2003 format xlWorkbookNormal here to save as xls
        NewWb.SaveAs fname, FileFormat:=-4143, CreateBackup:=False
        NewWb.Close False
        Set NewWb = Nothing

    End If
Else
    'Give the user the choice to save in 2000-2003 format or in one of the
    'new formats. Use the "Save as type" dropdown to make a choice,Default =
    'Excel Macro Enabled Workbook. You can add or remove formats to/from the list

    fname = Application.GetSaveAsFilename(InitialFileName:="", filefilter:= _
        " Excel Macro Free Workbook (*.xlsx), *.xlsx," & _
        " Excel Macro Enabled Workbook (*.xlsm), *.xlsm," & _
        " Excel 2000-2003 Workbook (*.xls), *.xls," & _
        " Excel Binary Workbook (*.xlsb), *.xlsb", _
        FilterIndex:=2, Title:="This example copies the ActiveSheet to a new workbook")

    'Find the correct FileFormat that match the choice in the "Save as type" list
    If fname <> False Then
        Select Case LCase(Right(fname, Len(fname) - InStrRev(fname, ".", , 1)))
        Case "xls": FileFormatValue = 56
        Case "xlsx": FileFormatValue = 51
        Case "xlsm": FileFormatValue = 52
        Case "xlsb": FileFormatValue = 50
        Case Else: FileFormatValue = 0
        End Select

        'Now we can create/Save the file with the xlFileFormat parameter
        'value that match the file extension
        If FileFormatValue = 0 Then
            MsgBox "Sorry, unknown file extension"
        Else
            'Copies the ActiveSheet to new workbook
            ActiveSheet.Copy
            Set NewWb = ActiveWorkbook

            'Save the file in the format you choose in the "Save as type" dropdown
            NewWb.SaveAs fname, FileFormat:= _
                         FileFormatValue, CreateBackup:=False
            NewWb.Close False
            Set NewWb = Nothing

        End If
    End If
End If
End Sub

Answer 1

更改代码的这一部分

fname = Application.GetSaveAsFilename(InitialFileName:=""

包含您想要的默认保存路径

fname = Application.GetSaveAsFilename(InitialFileName:=""C:\My Documents\"

确保留下尾部反斜杠，否则将建议使用文件名等于您提供的路径的默认文件，例如。

fname = Application.GetSaveAsFilename(InitialFileName:=""C:\My Documents"

将导致一个对话框，其中默认文件名为＆＃34; My Documents＆＃34;保存在位置＆＃34; C：\＆＃34;

如何更改默认＆＃34;另存为＆＃34; excel的目录路径？

1 个答案: