☰

Excel VBA - 将单元格中指定的范围打印为 Pdf 并通过 Outlook 发送

tag-icon • tag-icon microsoft-excel pdf vba printing
Excel VBA - 将单元格中指定的范围打印为 Pdf 并通过 Outlook 发送

我对 Excel VBA 非常不熟悉，但我正在尝试创建一个宏，将指定单元格范围打印为 PDF 并通过 Outlook 发送。

我没有进行以下工作：

  • 它没有保存到我的文档 N9 单元格中指定的文件夹
  • 它没有使用我在单元格 N10 中指定的名称保存 PDF
  • 最重要的是，它没有打印我在单元格 N4 中指定的范围内的 PDF
  • 另外，有没有办法绕过指定保存 PDF 文件夹的部分。直接进入电子邮件即可

以下是示例文件

这是我目前的代码，我没有使用 VBA 的经验

Sub Saveaspdfandsend()
Dim xSht As Worksheet
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xYesorNo As Integer
Dim xOutlookObj As Object
Dim xEmailObj As Object
Dim xUsedRng As Range

Set xSht = ActiveSheet
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

If xFileDlg.Show = True Then
   xFolder = xFileDlg.SelectedItems(1)
Else
   MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify Destination Folder"
   Exit Sub
End If
xFolder = ActiveSheet.Range("n9")
xFolder = xFolder + "\" + xSht.Name + ".pdf"

'Check if file already exist
If Len(Dir(xFolder)) > 0 Then
    xYesorNo = MsgBox(xFolder & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", _
                      vbYesNo + vbQuestion, "File Exists")
    On Error Resume Next
    If xYesorNo = vbYes Then
        Kill xFolder
    Else
        MsgBox "if you don't overwrite the existing PDF, I can't continue." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
        Exit Sub
    End If
    If Err.Number <> 0 Then
        MsgBox "Unable to delete existing file.  Please make sure the file is not open or write protected." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
        Exit Sub
    End If
End If

Set xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
    'Save as PDF file
    xSht.ExportAsFixedFormat Type:=xlTypePDF, FileName:=xFolder, Quality:=xlQualityStandard

    'Create Outlook email
    Set xOutlookObj = CreateObject("Outlook.Application")
    Set xEmailObj = xOutlookObj.CreateItem(0)
    With xEmailObj
        .Display
        .To = ActiveSheet.Range("n5")
        .CC = ActiveSheet.Range("n6")
        .Subject = ActiveSheet.Range("n7")
        .HTMLBody = "<font face=" & Chr(34) & "Calibri" & Chr(34) & " size=" & Chr(34) & 4 & Chr(34) & ">" & "Good day dear Master," & "<br> <br>" & ActiveSheet.Range("n8") & "<br> <br>" & Signature & "</font>"
        .Attachments.Add xFolder
        If DisplayEmail = False Then
            '.Send
        End If
    End With
Else
  MsgBox "The active worksheet cannot be blank"
  Exit Sub
End If
End Sub

答案1

“我对 Excel VBA 非常不熟悉“
有人很谦虚。

我没有看到任何可以指出并说“这就是问题所在”的东西；但是您的代码不断提到这个问题，ActiveSheet这可能是一件非常危险的事情。

像这样敲打的问题ActiveSheet在于，你无法确定ActiveSheet它是否符合你的预期。我数了数，它被调用了 6 次，这意味着有 6 次机会可以让任何数量的事物改变活动表并破坏你的程序。

当您开始使用错误的工作表时，会发生奇怪的事情。例如，由于读取了错误的单元格而无法保存文件。或者由于程序读取了错误工作表而无法正确打印UsedRange。

现在，我并不是说这就是导致问题的原因，但是你的代码写得足够好，我可以排除一个问题，但我无法排除这个问题。

相关内容