0
Существует синтаксис, который мы используем в нашем офисе, который автоматически генерирует отчеты из Excel в .pdfs для всех школ нашего района. Мой код:Создать новые вкладки
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, где каждая вкладка представляет собой школу?
См. [Следует использовать теги в заголовках?] (Http://meta.stackexchange.com/help/tagging). – pnuts