个人中心
gpt4 book ai didi

excel - 按需编译已禁用

转载 作者：行者123 更新时间：2023-12-02 10:48:15 25 4
gpt4 key购买 nike

自从我从 32 位 Office 2010 升级到 64 位 Office 后，我的一些宏一直表现得很麻烦。我收到了各种奇怪的错误，这些错误没有出现在我的 32 位计算机上，我正试图找出原因。

以下代码用于将 Excel 中的范围作为 PDF 发送给各种收件人。
工作原理:宏通过名称列表自行工作，每个名称在选定的 Excel 范围内给出不同的数字。随后为每个名称制作 PDF 并自动发送给在工作簿其他部分注册的收件人。

以下代码用于循环浏览姓名列表并发送电子邮件:

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() ，我收到以下消息:

Compile error:

Sub or Function not defined



我使用以下代码重定向到另一个模块: 
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() 中的以下位，即: 
RDB_Create_PDF

最佳答案

上面的问题是由一些正在编译的冗余代码引起的，这导致了编译错误。虽然这部分代码从来不需要运行Sub RDB_Selection_Range_To_PDF_And_Create_MailLOOP()首先，在另一个模块中仍然会导致编译错误。

主要的一点是，在安装 64 位 office 时，设置 Compile On Demand 被禁用。由于在安装之前启用了此设置，因此宏运行没有问题。

关于excel - 按需编译已禁用，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/36647945/

25 4 0
文章推荐： android-studio - Robolectric和Android Studio问题
文章推荐： java - 如何在 Java 8 中检查 Stream 是否包含另一个 Stream
文章推荐： java:随机时间生成器
文章推荐： xcode - 没有将AbsoluteTime类型导入Swift
行者123
个人简介

我是一名优秀的程序员,十分优秀！

滴滴打车优惠券免费领取
滴滴打车优惠券
全站热门文章
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com