时间戳

首页 > 解决方案 > 将excel打印页面转换为pdf并在打印页面上发送到电子邮件

excel - 将excel打印页面转换为pdf并在打印页面上发送到电子邮件

问题描述

我想在excel中制作一个VBA代码，但我被卡住了。我希望它把我的工作表放在我有几页要打印的地方（一张工作表中有 50 页）。

在每个打印页面上都有一个总和，如果该总和大于 0，我想将该页面转换为 pdf 并将打印页面发送到页面上的电子邮件（所以它是不同的电子邮件）。

总和在第 1 页F22，电子邮件在B8第 1 页。

总和在第 2 页F72，电子邮件在B58第 2 页。

因此，范围每页更改 50 行。

电子邮件区域B2:F50位于第一页，B52:F100第二页B102:F150位于第三页。

我已经尝试过，但只能用 1 页和 1 封电子邮件来完成。这是我的代码，适用于 1 页

Sub RDB_Selection_Range_To_PDF_And_Create_Mail()
Dim Charge As Integer
Charge = ThisWorkbook.Sheets("Crosscharge").Cells(23, 6).Value
If Charge > 0 Then
    Dim FileName 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
        FileName = RDB_Create_PDF(Source:=Range("B2:F50"), _
                                  FixedFilePathName:="", _
                                  OverwriteIfFileExist:=True, _
                                  OpenPDFAfterPublish:=False)

        If FileName <> "" Then
            RDB_Mail_PDF_Outlook FileNamePDF:=FileName, _
                                 StrTo:="Email", _
                                 StrCC:="", _
                                 StrBCC:="", _
                                 StrSubject:="Text", _
                                 Signature:=True, _
                                 Send:=False, _
                                 StrBody:="<H3><B>Dear Customer</B></H3><br>" & _
                                          "<body>See the attached PDF file with the." & _
                                          "<br><br>" & "Kind regards</body>"
        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

结束子

希望你能帮忙

标签： excelvbaemail-attachmentspdf-conversion

解决方案

你需要做的是实现一个循环。每个页面的单元格恰好相隔 50 个这一事实使您的代码非常容易。另请注意，我看到您是否在一开始就将单元格中的值分配F23给 an Integer。除非您可以保证它始终是一个整数（例如您正在四舍五入），否则最好将其定义为DoubleAlso 该Integer类型只能容纳 ~ - 20 亿到 20 亿之间的数字。如果您可能正在处理更大的数字，那么使用Long.

我无法完整地测试这段代码，因为你调用了一些自定义函数，但试试这个。如果有任何问题，请告诉我，我将更新此代码。

Sub RDB_Selection_Range_To_PDF_And_Create_Mail()
Dim Charge As Long
Dim LastRow As Long
Dim FileName As String
Dim i As Long

LastRow = sht.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row

If ActiveWindow.SelectedSheets.Count > 1 Then
        MsgBox "There is more then one sheet selected," & vbNewLine & _
               "ungroup the sheets and try the macro again"
End If

i = 23

Do While i <= LastRow

    Charge = ThisWorkbook.Sheets("Crosscharge").Cells(i, 6).Value
    If Charge > 0 Then
        'Call the function with the correct arguments
        'For a fixed range use this line
        FileName = RDB_Create_PDF(Source:=Range("B2:F" & i + 27), _
                                      FixedFilePathName:="", _
                                      OverwriteIfFileExist:=True, _
                                      OpenPDFAfterPublish:=False)

        If FileName <> "" Then
                RDB_Mail_PDF_Outlook FileNamePDF:=FileName, _
                                     StrTo:="Email", _
                                     StrCC:="", _
                                     StrBCC:="", _
                                     StrSubject:="Text", _
                                     Signature:=True, _
                                     Send:=False, _
                                     StrBody:="<H3><B>Dear Customer</B></H3><br>" & _
                                              "<body>See the attached PDF file with the." & _
                                              "<br><br>" & "Kind regards</body>"
        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
i = i + 50
Loop
End Sub

推荐阅读