Как изменить путь к каталогу «Сохранить как» для Excel?

Question

Привет, я просто вставляю этот код в свой макрос vba, но как изменить каталог по умолчанию, когда я использую этот макрос .. например, когда я нажимаю на него: D:/myfolder

Я нашел этот код в google:

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" 

приведет к диалогу, где по умолчанию файл с именем «Мои документы» сохраняется в папке «C: \»