2014-10-30 145 views
0

嗨我只是將此代碼嵌入到我的vba宏,但如何更改默認目錄,當我使用此宏..例如,當我點擊它將要D:/ myfolder如何更改Excel的默認「另存爲」目錄路徑?

我發現這個代碼在谷歌:

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 
+0

http://stackoverflow.com/questions/5148173/getsaveasfilename-default-文件夾可以滿足你的目的。 – ZAT 2014-10-30 09:11:21

回答

2

更改這部分代碼

fname = Application.GetSaveAsFilename(InitialFileName:="" 

包括默認保存路徑,你想

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

請確保您保留尾部反斜槓,否則會建議一個默認文件,其文件名與您提供的路徑相同,例如。

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

會導致在「我的文檔」保存在位置的名爲默認文件對話框「C:\」

+0

驚人!無論如何感謝你的代碼,它的工作:) – kappu 2014-10-30 11:18:22

+0

不客氣......我注意到一個額外的「在那裏蠕動,但我想你發現了。 – Cheesenbranston 2014-10-30 11:29:37