Excel 生成新选项卡

在我们的办公室里，我们使用了一种语法，可以将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

函数Create\u PDF（Myvar作为对象，FixedFilePathName作为字符串_
将EffileExist覆盖为布尔值，将OpenPDFAfterPublish（发布为布尔值）覆盖为字符串
Dim FileFormatstr作为字符串
Dim FName作为变体
'测试是否安装了Microsoft加载项
If目录（环境（“公共程序文件”）和“\Microsoft共享\OFFICE”_
&格式（Val（Application.Version），“00”和“\EXP\u PDF.DLL”）”，然后
如果FixedFilePathName=“”，则
'打开GetSaveAsFilename对话框以输入pdf的文件名
FileFormatstr=“PDF文件（*.PDF），*.PDF”
FName=Application.GetSaveAsFilename（“），filefilter:=FileFormatstr_
标题：=“创建PDF”）
'如果取消此对话框，请退出该函数
如果FName=False，则退出函数
其他的
FName=FixedFilePathName
如果结束
'如果OverwriteIfFileExist=False，我们将测试PDF
'已存在于文件夹中，如果为真，请退出该函数
如果OverwriteIfFileExist=False，则
如果Dir（FName）“，则退出函数
如果结束
'现在文件名正确，我们将发布为PDF
出错时继续下一步
Myvar.ExportAsFixedFormat_
类型：=xlTypePDF_
文件名：=FName_
质量：=xlQualityStandard_
IncludeDocProperties:=True_
IgnorePrintAreas:=假_
OpenAfterPublish:=OpenPDFAfterPublish
错误转到0
'如果发布正常，函数将返回文件名
如果Dir（FName）“，则创建\u PDF=FName
如果结束
端函数
Sub SaveAllYourReports（）
将MyFolder设置为字符串
将MyFile设置为字符串
Dim PDFname作为字符串
将文件名设置为字符串
出错时继续下一步
MyFolder=CreateObject（“WScript.Shell”）.SpecialFolders（“桌面”）&Application.PathSeparator和“PDF报告”
MkDir MyFolder
错误转到0
对于ActiveSheet.Range（“学校”）中的每个r
ActiveSheet.Range（“SelectedSchool”）.Value=r.Value
如果r.值为0，则
PDFname=r.值
MyFile=MyFolder&Application.PathSeparator&PDFname
FileName=Create_PDF（ActiveSheet.Range（“ReportArea”）、MyFile、True、False）
如果结束
下一个r
ActiveSheet.Range（“SelectedSchool”）.Value=ActiveSheet.Range（“FirstSchool”）.Value
端接头

---

是否有方法/如何修改现有代码，以便在Excel电子表格中创建唯一的选项卡，而不是创建.pdf，每个选项卡代表一所学校？

使用.添加到工作簿的工作表集合中。见：