- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 253
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2024-11-22
              
|
2#
發表於 2018-2-9 15:08
| 只看該作者
回復 1# JasonChen576
試試看- Sub CreatePDF()
- Dim Sh As Worksheet
- Application.ScreenUpdating = False
- Set fdo = CreateObject("Scripting.FileSystemObject")
- With Application.FileDialog(msoFileDialogFolderPicker)
- .Title = "選擇EXCEL檔案所在資料夾"
- .Show
- fd = .SelectedItems(1)
- f = IIf(fdo.driveExists(fd), "", "\") '判斷是是磁碟或資料夾
- End With
- If fdo.FolderExists(fd & f & "PDF") = False Then fdo.CreateFolder fd & f & "PDF" '在來源資料夾新增存放PDF的目的資料夾
- fs = Dir(fd & f & "*xls*")
- Do Until fs = ""
- With Workbooks.Open(fd & "\" & fs)
- For Each Sh In .Sheets '每個工作表做一個PDF檔案
- With Sh
- If Application.CountA(.Cells) > 0 Then
- .ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
- fd & "\PDF\" & fs & Sh.Name & ".pdf", Quality:=xlQualityStandard, _
- IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
- False
- End If
- End With
- Next
- .Close 0
- End With
- fs = Dir
- Loop
- Application.ScreenUpdating = True
- End Sub
|
|
發表於 2018-2-9 13:56
| 
