本文介绍了已解决 - 按需编译已禁用的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
自从我从32位Office 2010升级到64位Office后，我的一些宏已经表现出麻烦。我得到了不出现在我的32位计算机上的各种奇怪的错误，我想弄清楚为什么。
Ever since I've upgraded from 32-bit Office 2010 to 64-bit Office, some of my macro's have been behaving troublesome. I get various weird errors that do not appear on my 32-bit computer and I'm trying to figure out why.
以下代码用于将Excel中的范围以PDF格式发送给各个收件人。
工作原理：宏通过名称列表自己工作，每个名称在选定的Excel范围中给出不同的数字。随后为每个名称生成PDF并自动发送到在工作簿的其他部分注册的收件人。
The following code is used to send a range in Excel as PDF to various recipients.How it works: the macro works itself through a list of names, with each name giving different figures in the selected Excel range. Subsequently for each name the PDF is made and send automatically to the recipients registered in other parts of the workbook.
以下代码用于遍历名称列表并发送电子邮件：
The following code is used to cycle through the list of names and send the e-mails:
Sub RDB_Selection_Range_To_PDF_And_Create_MailLOOP()
Range("AirportFWTop33").FormulaR1C1 = "=R[0]C[+2]"
Call RDB_Selection_Range_To_PDF_And_Create_Mail
Range("AirportFWTop33").FormulaR1C1 = "=R[1]C[+2]"
Call RDB_Selection_Range_To_PDF_And_Create_Mail
Range("AirportFWTop33").FormulaR1C1 = "=R[2]C[+2]"
Call RDB_Selection_Range_To_PDF_And_Create_Mail
Range("AirportFWTop33").FormulaR1C1 = "=R[3]C[+2]"
Call RDB_Selection_Range_To_PDF_And_Create_Mail
Range("AirportFWTop33").FormulaR1C1 = "=R[4]C[+2]"
Call RDB_Selection_Range_To_PDF_And_Create_Mail
Range("AirportFWTop33").FormulaR1C1 = "=R[5]C[+2]"
Call RDB_Selection_Range_To_PDF_And_Create_Mail
Range("AirportFWTop33").FormulaR1C1 = "=R[6]C[+2]"
Call RDB_Selection_Range_To_PDF_And_Create_Mail
Range("AirportFWTop33").FormulaR1C1 = "=R[7]C[+2]"
Call RDB_Selection_Range_To_PDF_And_Create_Mail
Range("AirportFWTop33").FormulaR1C1 = "=R[8]C[+2]"
Call RDB_Selection_Range_To_PDF_And_Create_Mail
Range("AirportFWTop33").FormulaR1C1 = "=R[9]C[+2]"
Call RDB_Selection_Range_To_PDF_And_Create_Mail
Range("AirportFWTop33").FormulaR1C1 = "=R[10]C[+2]"
Call RDB_Selection_Range_To_PDF_And_Create_Mail
Range("AirportFWTop33").FormulaR1C1 = "=R[11]C[+2]"
Call RDB_Selection_Range_To_PDF_And_Create_Mail
Range("AirportFWTop33").FormulaR1C1 = "=R[12]C[+2]"
Call RDB_Selection_Range_To_PDF_And_Create_Mail
Range("AirportFWTop33").FormulaR1C1 = "=R[13]C[+2]"
Call RDB_Selection_Range_To_PDF_And_Create_Mail
Range("AirportFWTop33").FormulaR1C1 = "=R[14]C[+2]"
Call RDB_Selection_Range_To_PDF_And_Create_Mail
Range("AirportFWTop33").FormulaR1C1 = "=R[15]C[+2]"
Call RDB_Selection_Range_To_PDF_And_Create_Mail
End Sub
Sub RDB_Selection_Range_To_PDF_And_Create_Mail()
Dim FileName As String
Dim FixedFilePathName As String
If ActiveWindow.SelectedSheets.Count > 1 Then
MsgBox "There is more then one sheet selected," & vbNewLine & _
"ungroup the sheets and try the macro again"
Else
'Call the function with the correct arguments
'For a fixed range use this line
FixedFilePathName = "Weekly Performance Summary - " & Range("AirportFWTop33") & " - " & Range("month")
FileName = RDB_Create_PDF_FWTop33(Range("KPISummaryFWTop33"), "C:\Users\user1\Desktop\WeeklyReport.pdf", True, False)
'For the selection use this line
'FileName = RDB_Create_PDF(Selection, "", True, False)
'For a fixed file name and overwrite it each time you run the macro use
'RDB_Create_PDF(Selection, "C:\Users\Ron\Test\YourPdfFile.pdf", True, False)
If FileName <> "" Then
RDB_Mail_PDF_Outlook FileName, Range(Range("EmailtoFWTop33")), Range(Range("EmailccFWTop33")), "easyJet Ground Operations - Weekly Performance Summary - " & Range("AirportFWTop33") & " - " & Range("Week"), _
"Hi," & vbNewLine & "Please see the attached your weekly performance report. ", True
Else
MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
"Microsoft Add-in is not installed" & vbNewLine & _
"You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
"The path to Save the file in arg 2 is not correct" & vbNewLine & _
"You didn't want to overwrite the existing PDF if it exist"
End If
End If
End Sub
Sub KPISummaryNFWTop33Email()
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Set rng = Nothing
On Error Resume Next
'Only the visible cells in the selection
Set rng = Range("KPISummaryFWTop33").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected" & _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
OutMail.Display
.BodyFormat = olFormatRichText
.To = Range(Range("EmailToFWTop33"))
.CC = Range(Range("EmailccFWTop33"))
.BCC = ""
.Subject = "Weekly Performance Summary - " & Range("AirportFWTop33") & " - " & Range("week")
.HTMLBody = RangetoHTMLKPISummaryFWTop33(rng)
'.Display
.Send
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Function RangetoHTMLKPISummaryFWTop33(rng As Range)
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
'Copy the range and create a new workbook to past the data in
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
Columns.AutoFit
End With
'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
FileName:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
'Read all data from the htm file into RangetoHTMLAJA
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTMLKPISummaryFWTop33 = ts.readall
ts.Close
RangetoHTMLHTMLKPISummaryFWTop33 = Replace(RangetoHTMLKPISummaryFWTop33, "align=center x:publishsource=", _
"align=left x:publishsource=")
'Close TempWB
TempWB.Close savechanges:=False
'Delete the htm file we used in this function
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
当我尝试运行 Sub RDB_Selection_Range_To_PDF_And_Create_MailLOOP（）时，我收到以下消息：
When I try to run Sub RDB_Selection_Range_To_PDF_And_Create_MailLOOP(), I get the following message:
未定义子或函数
我被重定向到另一个模块与以下代码：
I'm redirected to another module with the following code:
Option Explicit
'Note: The macro's in this module call the functions in the "FunctionsModule"
'Be sure that you also copy the code from this module if you want to use it in your own workbook.
Sub RDB_Workbook_To_PDF()
Dim FileName As String
'Call the function with the correct arguments
FileName = RDB_Create_PDF(ActiveWorkbook, "", True, True)
'For a fixed file name and overwrite it each time you run the macro use
'RDB_Create_PDF(ActiveWorkbook, "C:\Users\Ron\Test\YourPdfFile.pdf", True, True)
If FileName <> "" Then
'Ok, you find the PDF where you saved it
'You can call the mail macro here if you want
Else
MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
"Microsoft Add-in is not installed" & vbNewLine & _
"You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
"The path to Save the file in arg 2 is not correct" & vbNewLine & _
"You didn't want to overwrite the existing PDF if it exist"
End If
End Sub
Option Explicit
'The code below are used by the macros in the other two modules
'Do not change the code in the functions in this module
Function RDB_Create_PDF_FWTop33(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(Range("AirportFWTop33") & " - " & Range("week"), 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 RDB_Create_PDF_FWTop33 = Fname
End If
End Function
'The code below are used by the macros in the other two modules
'Do not change the code in the functions in this module
Function RDB_Create_PDF_NFWTop33(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(Range("AirportNFWTop33") & " - " & Range("week"), 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 RDB_Create_PDF_NFWTop33 = Fname
End If
End Function
'The code below are used by the macros in the other two modules
'Do not change the code in the functions in this module
Function RDB_Create_PDF_NFWOther(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(Range("AirportNFWOther") & " - " & Range("week"), 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 RDB_Create_PDF_NFWOther = Fname
End If
End Function
'The code below are used by the macros in the other two modules
'Do not change the code in the functions in this module
Function RDB_Create_PDF_FWOther(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(Range("AirportFWOther") & " - " & Range("week"), 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 RDB_Create_PDF_FWOther = Fname
End If
End Function
Function RDB_Mail_PDF_Outlook(FileNamePDF As String, StrTo As String, StrCC As String, StrSubject As String, StrBody As String, Send As Boolean)
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = StrTo
.CC = StrCC
.BCC = ""
.Subject = StrSubject
.Body = StrBody
.Attachments.Add FileNamePDF
If Send = True Then
.Send
Else
.Display
End If
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Function
Function Create_PDF_Sheet_Level_Names(NamedRange As String, FixedFilePathName As String, _
OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
'This function will create a PDF with every sheet with
'a sheet level name variable <NamedRange> in it
Dim FileFormatstr As String
Dim Fname As Variant
Dim Ash As Worksheet
Dim sh As Worksheet
Dim ShArr() As String
Dim S As Long
Dim SheetLevelName As Name
'Test If the Microsoft Add-in is installed
If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _
& Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then
'We fill the Array with sheets with the sheet level name variable
For Each sh In ActiveWorkbook.Worksheets
If sh.Visible = -1 Then
Set SheetLevelName = Nothing
On Error Resume Next
Set SheetLevelName = sh.Names(NamedRange)
On Error GoTo 0
If Not SheetLevelName Is Nothing Then
S = S + 1
ReDim Preserve ShArr(1 To S)
ShArr(S) = sh.Name
End If
End If
Next sh
'We exit the function If there are no sheets with
'a sheet level name variable named <NamedRange>
If S = 0 Then Exit Function
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
Application.ScreenUpdating = False
Application.EnableEvents = False
'Remember the ActiveSheet
Set Ash = ActiveSheet
'Select the sheets with the sheet level name in it
Sheets(ShArr).Select
'Now the file name is correct we Publish to PDF
On Error Resume Next
ActiveSheet.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_Sheet_Level_Names = Fname
End If
Ash.Select
Application.ScreenUpdating = True
Application.EnableEvents = True
End If
End Function
Sub CreatePowerPointTest()
'First we declare the variables we will be using
Dim newPowerPoint As PowerPoint.Application
Dim myPresentation As PowerPoint.Presentation
Dim activeSlide As PowerPoint.Slide
Dim cht As Excel.ChartObject
Dim shp As PowerPoint.ShapeRange
Dim MySlideArray As Variant
Dim MyRangeArray As Variant
Dim x As Long
'Look for existing instance
On Error Resume Next
Set newPowerPoint = GetObject(, "PowerPoint.Application")
On Error GoTo 0
'Let's create a new PowerPoint
If newPowerPoint Is Nothing Then
Set newPowerPoint = New PowerPoint.Application
End If
'Make a presentation in PowerPoint
If newPowerPoint.Presentations.Count = 0 Then
newPowerPoint.Presentations.Add
End If
'Show the PowerPoint
newPowerPoint.Visible = True
'SLIDE1 - Sections A & B
'Add a new slide where we will paste the chart
newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutBlank
newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count
Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count)
'Copy the chart and paste it into the PowerPoint as a Metafile Picture
ActiveWorkbook.Sheets("KPI Summary FW TOP 33").Range("KPISummaryFWTop33A").Copy
activeSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select
'Adjust the positioning of the Chart on Powerpoint Slide
newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 0
newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 0
'Copy the chart and paste it into the PowerPoint as a Metafile Picture
ActiveWorkbook.Sheets("KPI Summary FW TOP 33").Range("KPISummaryFWTop33E").Copy
activeSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select
'Adjust the positioning of the Chart on Powerpoint Slide
newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 0
newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 350
'Copy the chart and paste it into the PowerPoint as a Metafile Picture
ActiveWorkbook.Sheets("KPI Summary FW TOP 33").Range("KPISummaryFWTop33B").Copy
activeSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select
'Adjust the positioning of the Chart on Powerpoint Slide
newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 350
newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 0
'SLIDE2 - Section D
'Add a new slide where we will paste the chart
newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutBlank
newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count
Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count)
'Copy the chart and paste it into the PowerPoint as a Metafile Picture
ActiveWorkbook.Sheets("KPI Summary FW TOP 33").Range("KPISummaryFWTop33C").Copy
activeSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select
'Adjust the positioning of the Chart on Powerpoint Slide
newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 0
newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 0
'Copy the chart and paste it into the PowerPoint as a Metafile Picture
ActiveWorkbook.Sheets("KPI Summary FW TOP 33").Range("KPISummaryFWTop33D").Copy
activeSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select
'Adjust the positioning of the Chart on Powerpoint Slide
newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 350
newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 0
End Sub
Sub RDB_Selection_Range_To_PDF_And_Create_Mail()
Dim FileName As String
Dim FixedFilePathName As String
If ActiveWindow.SelectedSheets.Count > 1 Then
MsgBox "There is more then one sheet selected," & vbNewLine & _
"ungroup the sheets and try the macro again"
Else
'Call the function with the correct arguments
'For a fixed range use this line
FixedFilePathName = "Weekly Performance Summary - " & Range("AirportFWTop33") & " - " & Range("week")
FileName = RDB_Create_PDF(Range("KPISummaryFWTop33"), "", True, False)
'For the selection use this line
'FileName = RDB_Create_PDF(Selection, "", True, False)
'For a fixed file name and overwrite it each time you run the macro use
'RDB_Create_PDF(Selection, "C:\Users\Ron\Test\YourPdfFile.pdf", True, False)
If FileName <> "" Then
RDB_Mail_PDF_Outlook FileName, Range(Range("EmailtoFWTop33")), Range(Range("EmailccFWTop33")), "Weekly Performance Summary - " & Range("AirportFWTop33") & " - " & Range("week"), _
"Please see the attached your weekly performance report" _
& vbNewLine & vbNewLine & "Regards, Max Hashim", False
Else
MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
"Microsoft Add-in is not installed" & vbNewLine & _
"You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
"The path to Save the file in arg 2 is not correct" & vbNewLine & _
"You didn't want to overwrite the existing PDF if it exist"
End If
End If
End Sub
错误选择 Sub RDB_Workbook_To_PDF（）中的以下位，即：
The error selects the following bit in Sub RDB_Workbook_To_PDF(), namely:
RDB_Create_PDF
推荐答案
上面的问题是由编译的一些冗余代码导致的，这导致了编译错误。虽然这部分代码从来不需要运行 Sub RDB_Selection_Range_To_PDF_And_Create_MailLOOP（），但是在另一个模块中仍然会导致编译错误 。
The issue above was cause by some redundant piece of code that was being compiled, which caused the Compile error. Although this part of the code was never required to run Sub RDB_Selection_Range_To_PDF_And_Create_MailLOOP() in the first place, being in an other module still cause the Compile error.
主要的一点是，在安装64位办公室时，设置 Compile On Demand 被禁用。由于此设置在安装之前启用，所以宏运行没有问题。
The main point was that upon installing 64-bit office, the setting Compile On Demand was disabled. Since this setting was enabled before installation, the macro's ran without problems.
这篇关于已解决 - 按需编译已禁用的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！