Impressão direta no desktop pressionando CTRL+P

WORD 2019

ALT+F11

À esquerda no config de macros, clicar com o botão direito em “NORMAL” – INSERIR – Módulo.

COLAR:

Sub ImprimirPDFDiretoDesktop()
Dim caminhoDesktop As String
Dim nomeArquivo As String
Dim caminhoCompleto As String
Dim fso As Object
' Localiza o caminho da Área de Trabalho do sistema atual
caminhoDesktop = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
' Obtém o nome do documento aberto
nomeArquivo = ActiveDocument.Name
' Remove a extensão original (.docx, .doc) para adicionar .pdf
Set fso = CreateObject("Scripting.FileSystemObject")
nomeArquivo = fso.GetBaseName(nomeArquivo) & ".pdf"
' Define o destino final do arquivo
caminhoCompleto = caminhoDesktop & nomeArquivo
' Executa a exportação direta para PDF
On Error GoTo ErroExportacao
ActiveDocument.ExportAsFixedFormat _
OutputFileName:=caminhoCompleto, _
ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=False, _
OptimizeFor:=wdExportOptimizeForPrint, _
Range:=wdExportAllDocument, _
Item:=wdExportDocumentContent, _
IncludeDocProps:=True, _
KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, _
DocStructureTags:=True, _
BitmapMissingFonts:=True, _
UseISO19005_1:=False
MsgBox "PDF gerado e salvo na Área de Trabalho:" & vbCrLf & nomeArquivo, vbInformation, "Concluído"
Exit Sub
ErroExportacao:
MsgBox "Falha ao criar o PDF. O arquivo pode estar aberto em outro programa.", vbCritical, "Erro"
End Sub

Depois vai:

  1. Opções
  2. Personalizar faixa de opções
  3. Personalizar…
  4. Macros
  5. ImprimirDiretoDesktop
  6. Seta CTRL+P pra ele

Feito!