Повысить качество печати экрана пользовательской формы - PullRequest
0 голосов
/ 01 апреля 2019

У меня есть код для копирования пользовательской формы и вставки его на рабочий стол пользователя в виде файла 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

1 Ответ

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

Ответ из раздела комментариев:

Worksheet.PasteSpecial метод (Excel) . Вы должны иметь возможность вызывать формат по номеру, так что формат: = 4 для растрового изображения или формат: = 0 для png и т. Д.

Исправленная строка появляется:

newWS.PasteSpecial Format:=0, Link:=False, DisplayAsIcon:=False
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...