☰

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錯誤的紙張。

現在，我並不是說這就是導致問題的原因，但是您的程式碼寫得足夠好，我可以排除問題，但我無法排除這個問題。

相關內容