返回列表 上一主題 發帖

工作表另存新檔和以儲存格內容命名

本帖最後由 singo1232001 於 2023-12-8 03:07 編輯

回復 9# missbb


    Sub 同資料夾導出()

Set outSh = ActiveSheet
Set myBook = ThisWorkbook
        
Filename = outSh.[G2].Value & " " & Format(Now, "yyyyMMdd_HHnnss") & ".xlsx"
' 設定檔案保存路徑(更改為所需路徑)
filePath = myBook.Path & "\" & Filename

outSh.Copy
Set NewWorkbook = ActiveWorkbook
    ' 保存新工作簿
NewWorkbook.SaveAs Filename:=filePath
End Sub


Sub G1G2另存路徑導出()

Set outSh = ActiveSheet
Set myBook = ThisWorkbook
        
Filename = outSh.[G2].Value & " " & Format(Now, "yyyyMMdd_HHnnss") & ".xlsx"
' 設定檔案保存路徑(更改為所需路徑)
filePath = Range("G1").Value & "\" & Filename

outSh.Copy
Set NewWorkbook = ActiveWorkbook
    ' 保存新工作簿
NewWorkbook.SaveAs Filename:=filePath
End Sub



Sub 資料選擇器路徑導出()


Set fd = Excel.Application.FileDialog(msoFileDialogFolderPicker)  '設定選取檔案功能
fd.InitialFileName = Excel.ActiveWorkbook.Path  '設定預設目錄
fd.Show '顯示對話框
If fd.SelectedItems.Count = 0 Then Exit Sub
Set myBook = ThisWorkbook
Set outSh = ActiveSheet
myPath = fd.SelectedItems(1)

Filename = outSh.[G2].Value & " " & Format(Now, "yyyyMMdd_HHnnss") & ".xlsx"
' 設定檔案保存路徑(更改為所需路徑)
filePath = Range("G1").Value & "\" & Filename

outSh.Copy
Set NewWorkbook = ActiveWorkbook
    ' 保存新工作簿
NewWorkbook.SaveAs Filename:=filePath
End Sub

TOP

        靜思自在 : 口說一句好話,如口出蓮花;口說一句壞話如口吐毒蛇。
返回列表 上一主題