¦p¦ó¥ÎVBA§å¦¸ÂàÀɦ¨¬°PDF¥[±KÀɮסH

JasonChen576

¥Ø«e¥u§ä¨ì¨Ï¥Î¤Þ¥ÎPDFCreator¡C
¦ý¦³µL¤ñ¸û²³æªº¤èªk©O¡H

Hsieh

¦^´_ 1# JasonChen576
¸Õ¸Õ¬Ý

1. Sub CreatePDF()
   
2. Dim Sh As Worksheet
   
3. Application.ScreenUpdating = False
   
4. Set fdo = CreateObject("Scripting.FileSystemObject")
   
5. With Application.FileDialog(msoFileDialogFolderPicker)
   
6.    .Title = "¿ï¾ÜEXCELÀɮשҦb¸ê®Æ§¨"
   
7.    .Show
   
8.    fd = .SelectedItems(1)
   
9.    f = IIf(fdo.driveExists(fd), "", "\") '§PÂ_¬O¬OºÏºÐ©Î¸ê®Æ§¨
   
10. End With
    
11. If fdo.FolderExists(fd & f & "PDF") = False Then fdo.CreateFolder fd & f & "PDF" '¦b¨Ó·½¸ê®Æ§¨·s¼W¦s©ñPDFªº¥Øªº¸ê®Æ§¨
    
12. fs = Dir(fd & f & "*xls*")
    
13. Do Until fs = ""
    
14. With Workbooks.Open(fd & "\" & fs)
    
15.    For Each Sh In .Sheets '¨C­Ó¤u§@ªí°µ¤@­ÓPDFÀÉ®×
    
16.        With Sh
    
17.         If Application.CountA(.Cells) > 0 Then
    
18.             .ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    
19.              fd & "\PDF\" & fs & Sh.Name & ".pdf", Quality:=xlQualityStandard, _
    
20.              IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
    
21.              False
    
22.          End If
    
23.        End With
    
24.     Next
    
25.     .Close 0
    
26. End With
    
27. fs = Dir
    
28. Loop
    
29. Application.ScreenUpdating = True
    
30. End Sub

½Æ»s¥N½X

JasonChen576

¦^´_ 2# Hsieh


    ·PÁ¤j¤j½ç±Ð¡ã
½Ð°ÝPDF¦pªG­n¥[¤W±K½X©O¡H