Конвертировать Excel Print страницу в PDF и отправить по электронной почте на странице печати - PullRequest
Новая
       61

Конвертировать Excel Print страницу в PDF и отправить по электронной почте на странице печати

0 голосов
/ 01 апреля 2019

Я хотел бы сделать код VBA в Excel, но я застрял. Я хочу, чтобы он взял мой лист, где у меня есть несколько страниц для печати (50 страниц на одном листе).

На каждой странице печати есть сумма, и если эта сумма больше 0, я хочу преобразовать эту страницу в pdf и отправить страницу печати на электронное письмо на странице (так что это разные электронные письма).

Сумма указана в F22, а электронная почта в B8 на стр. 1.

Сумма указана в 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

End Sub

Надеюсь, вы можете помочь

1 Ответ

0 голосов
/ 02 апреля 2019

Что вам нужно сделать, это реализовать цикл.Тот факт, что ваши ячейки расположены точно на расстоянии 50 для каждой страницы, делает этот код очень простым для вашего кода.Еще одно замечание, которое я вижу, если вы присваиваете значение в ячейке F23 Integer в самом начале.Если вы не можете гарантировать, что это всегда будет целое число (например, вы округляете), может быть лучше определить его как Double Также тип Integer может содержать только числа от ~ - 2 млрд до 2 млрд.Если вы можете иметь дело с числами большего размера, используйте 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
...