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

Question

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

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

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

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

因此范围每页变化 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

结束子

希望能帮到你

Answer 1

你需要做的是实现一个循环。事实上，每页的单元格恰好相隔 50 个，这对您的代码来说非常容易。另一个注意事项是，我看到您是否在一开始就将单元格 F23 中的值分配给了 Integer。除非你能保证它永远是一个整数（例如你正在四舍五入），否则最好将它定义为 Double 而且 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

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

Convert excel print page to pdf and send to email on the print page

excel

vba

email-attachments

pdf-conversion