已解决 - 按需编译已禁用 [英] SOLVED - Compile On Demand Disabled

问题描述

自从我从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:

编译错误：

Compile error:

未定义子或函数

我被重定向到另一个模块与以下代码：

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.

这篇关于已解决 - 按需编译已禁用的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！