按需编译禁用 [英] Compile On Demand Disabled

查看:31
本文介绍了按需编译禁用的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!

问题描述

自从我从 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:Usersuser1DesktopWeeklyReport.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:UsersRonTestYourPdfFile.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:UsersRonTestYourPdfFile.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 SharedOFFICE" _
         & 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 SharedOFFICE" _
         & 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 SharedOFFICE" _
         & 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 SharedOFFICE" _
         & 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 SharedOFFICE" _
         & 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:UsersRonTestYourPdfFile.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 位 office 时,设置 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屋!

查看全文
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆