2015-09-23 135 views
0

我們在辦公室使用的語法是,將Excel中的報告自動生成爲本地區所有學校的.pdf。我的代碼:生成新標籤

Function Create_PDF(Myvar As Object, FixedFilePathName As String, _ 
        OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String 
    Dim FileFormatstr As String 
    Dim FName As Variant 

'Test If the Microsoft Add-in is installed 
If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _ 
    & Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then 

    If FixedFilePathName = "" Then 
     'Open the GetSaveAsFilename dialog to enter a file name for the pdf 
     FileFormatstr = "PDF Files (*.pdf), *.pdf" 
     FName = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, _ 
               Title:="Create PDF") 

     'If you cancel this dialog Exit the function 
     If FName = False Then Exit Function 
    Else 
     FName = FixedFilePathName 
    End If 

    'If OverwriteIfFileExist = False we test if the PDF 
    'already exist in the folder and Exit the function if that is True 
    If OverwriteIfFileExist = False Then 
     If Dir(FName) <> "" Then Exit Function 
    End If 

    'Now the file name is correct we Publish to PDF 
    On Error Resume Next 
    Myvar.ExportAsFixedFormat _ 
      Type:=xlTypePDF, _ 
      FileName:=FName, _ 
      Quality:=xlQualityStandard, _ 
      IncludeDocProperties:=True, _ 
      IgnorePrintAreas:=False, _ 
      OpenAfterPublish:=OpenPDFAfterPublish 
    On Error GoTo 0 

    'If Publish is Ok the function will return the file name 
    If Dir(FName) <> "" Then Create_PDF = FName 
End If 

End Function 
Sub SaveAllYourReports() 

Dim MyFolder As String 
Dim MyFile As String 
Dim PDFname As String 
Dim FileName As String 

On Error Resume Next 
MyFolder = CreateObject("WScript.Shell").SpecialFolders("Desktop") & Application.PathSeparator & "PDF Reports" 
MkDir MyFolder 
On Error GoTo 0 

For Each r In ActiveSheet.Range("Schools") 

    ActiveSheet.Range("SelectedSchool").Value = r.Value 
    If r.Value <> 0 Then 

    PDFname = r.Value 
    MyFile = MyFolder & Application.PathSeparator & PDFname 
    FileName = Create_PDF(ActiveSheet.Range("ReportArea"), MyFile, True, False) 
    End If 

    Next r 
    ActiveSheet.Range("SelectedSchool").Value = ActiveSheet.Range("FirstSchool").Value 
End Sub 

有什麼辦法/如何修改我們現有的代碼,這樣,而不是創建.pdfs的,它在Excel電子表格,其中每個標籤代表一個學校創建獨特的標籤?

+0

請參閱[我應該在標題中使用標籤嗎?](http://meta.stackexchange.com/help/tagging)。 – pnuts

回答