Question

我有一个用于复制用户表单并将其作为pdf文件粘贴到用户桌面的代码。 Pdf文件还可以，但是其中的图像质量很差。有什么办法可以提高pdf文件中图像的质量？

Private Sub btnPrintPDF_Click()
'change to your button name
    Dim pdfName As String
    Dim newWS As Worksheet

    Application.DisplayAlerts = False

    keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
    keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0

    DoEvents 'Otherwise, all of screen would be pasted as if PrtScn rather than Alt+PrtScn was used for the copy.

    Set newWS = ThisWorkbook.Worksheets.Add(After:=Worksheets(Worksheets.Count))
    Application.PrintCommunication = False
With newWS.PageSetup
    .Orientation = xlPortrait
    .Zoom = False
 .FitToPagesTall = 1
 .FitToPagesWide = 1
End With
Application.PrintCommunication = True
    newWS.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
    pdfName = Environ$("USERPROFILE") & "\Desktop\" & ThisWorkbook.Sheets("Other Data").Range("P14").Value & "," & " " & "Summary" & "_" & Format(Now, "dd.mm.yyyy") & ".pdf"
newWS.ExportAsFixedFormat Type:=xlTypePDF, _
    FileName:=pdfName, Quality:=xlQualityStandard, _
    IncludeDocProperties:=False, IgnorePrintAreas:=False, _
    OpenAfterPublish:=False
    newWS.Delete
    Unload Me

    Application.DisplayAlerts = True
    ThisWorkbook.Sheets("MAIN").Activate

End Sub

Answer 1

评论部分的答案：

Worksheet.PasteSpecial method (Excel)。您应该能够通过数字调用格式，例如format：= 4用于位图，或者format：= 0是png等。

出现更正的行：

newWS.PasteSpecial Format:=0, Link:=False, DisplayAsIcon:=False

提高用户表单打印屏幕的质量

1 个答案: