Блог

Справочная информация: С помощью StackOverflow я успешно нашел способ копирования определенного содержимого (текста, таблиц и диаграмм) из Excel в шаблон Word с закладками с помощью VBA. Сохраняя это, я не хочу формат .docx, но вместо этого хочу экспортировать его в .pdf. Я попытался использовать ExportAsFixedFormat и ExportAsFixedFormat2 и смог успешно экспортировать его.

Проблема: Содержимое этого файла .pdf экспортируется в виде изображения (я думаю). Я не могу выделить или скопировать текст из файла. Что я делаю не так и как я могу это исправить? (К вашему сведению, копирование содержимого в pdf установлено в «Разрешено»)

В настоящее время я использую ActiveDocument.ExportAsFixedFormat2 SaveName, wdExportFormatPDF, , wdExportOptimizeForPrint и пробовал другие переменные.

Любая помощь будет очень признательна.

Код:

 Option Explicit

Sub ExportFile()

    Dim wrdApp As Word.Application
    Dim WrdDoc As Word.Document
    Dim WrdRng As Word.Range
    Dim WrdShp As Word.InlineShape
    Dim SaveName As String
    
    Dim ChrObj As ChartObject
    
    Set wrdApp = New Word.Application
    'wrdApp.Visible = True
    'wrdApp.Activate
    
    With wrdApp
        
        .Documents.Add Environ("UserProfile") amp; "DesktopTemplate.dotx"
        
        
        With .Selection
        Range("XEX771").Copy
            .GoTo What:=-1, Name:="Bookmark1"
            .PasteSpecial xlPasteValues
            .GoTo What:=-1, Name:="Bookmark2"
        Range("AG696", Range("AG696").End(xlDown).End(xlToRight)).Copy
        Application.Wait Now()   #12:00:02 AM#
            .PasteExcelTable True, False, False
            .GoTo What:=-1, Name:="Bookmark3"
        Range("F26", Range("F26").End(xlDown).End(xlToRight)).Copy
        Application.Wait Now()   #12:00:02 AM#
            .PasteExcelTable True, False, False
            .GoTo What:=-1, Name:="Bookmark4"
        Range("XEO5").Copy
            .PasteSpecial xlPasteValues
            .GoTo What:=-1, Name:="Bookmark5"
        Range("K26", Range("K26").End(xlDown).End(xlToRight)).Copy
        Application.Wait Now()   #12:00:02 AM#
            .PasteExcelTable True, False, False
        End With
    
    Set ChrObj = ActiveSheet.ChartObjects(1)
        ChrObj.Chart.ChartArea.Copy
        
        Application.Wait Now()   #12:00:02 AM#
        
    .Selection.GoTo What:=-1, Name:="Bookmark6"
    .Selection.PasteSpecial DataType:=wdPasteMetafilePicture, Placement:=wdInLine
    
    Set ChrObj = ActiveSheet.ChartObjects(2)
        ChrObj.Chart.ChartArea.Copy
        
        Application.Wait Now()   #12:00:02 AM#
        
    .Selection.GoTo What:=-1, Name:="Bookmark7"
    .Selection.PasteSpecial DataType:=wdPasteMetafilePicture, Placement:=wdInLine

    Set ChrObj = ActiveSheet.ChartObjects(3)
        ChrObj.Chart.ChartArea.Copy
        
        Application.Wait Now()   #12:00:02 AM#
        
    .Selection.GoTo What:=-1, Name:="Bookmark8"
    .Selection.PasteSpecial DataType:=wdPasteMetafilePicture, Placement:=wdInLine
   
SaveName = Environ("UserProfile") amp; "DesktopFileName.pdf"

    .ActiveDocument.ExportAsFixedFormat2 SaveName, wdExportFormatPDF, , wdExportOptimizeForPrint

    End With

wrdApp.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
wrdApp.Quit

Set wrdApp = Nothing

End Sub
 

Использование выбора очень неэффективно, что также может помочь объяснить, почему вы вставили так много задержек в свой код. У вас также есть множество ненужных .Операции перехода и копирования/вставки. Попробуй:

 Sub ExportFile()
Dim wrdApp As New Word.Application, WrdDoc As Word.Document
Dim WrdRng As Word.Range, WrdShp As Word.InlineShape
Dim xlSheet As Excel.Worksheet: Set xlSheet = ActiveSheet
With wrdApp
  .Visible = False
  Set WrdDoc = .Documents.Add(Environ("UserProfile") amp; "DesktopTemplate.dotx")
  With WrdDoc
    .Bookmarks("Bookmark1").Range.Text = xlSheet.Range("XEX771").Text
    xlSheet.Range("AG696", Range("AG696").End(xlDown).End(xlToRight)).Copy
    .Bookmarks("Bookmark2").Range.PasteExcelTable True, False, False
    xlSheet.Range("F26", Range("F26").End(xlDown).End(xlToRight)).Copy
    .Bookmarks("Bookmark3").Range.PasteExcelTable True, False, False
    .Bookmarks("Bookmark4").Range.Text = xlSheet.Range("XEO5").Text
    xlSheet.Range("K26", Range("K26").End(xlDown).End(xlToRight)).Copy
    .Bookmarks("Bookmark5").Range.PasteExcelTable True, False, False
    xlSheet.ChartObjects(1).Chart.ChartArea.Copy
    .Bookmarks("Bookmark6").Range.PasteSpecial DataType:=wdPasteMetafilePicture, Placement:=wdInLine
    xlSheet.ChartObjects(2).Chart.ChartArea.Copy
    .Bookmarks("Bookmark7").Range.PasteSpecial DataType:=wdPasteMetafilePicture, Placement:=wdInLine
    xlSheet.ChartObjects(3).Chart.ChartArea.Copy
    .Bookmarks("Bookmark8").Range.PasteSpecial DataType:=wdPasteMetafilePicture, Placement:=wdInLine
    .SaveAs FileName:=Environ("UserProfile") amp; "DesktopFileName.pdf", _
      FileFormat:=wdFormatPDF, AddToRecentFiles:=False
    .Close False
  End With
  .Quit
End With
Set WrdDoc = Nothing: Set wrdApp = Nothing: Set xlSheet = Nothing
End Sub
 

Это была проблема с опцией «Растровый текст, когда шрифты могут не быть встроены» при сохранении PDF-файлов через MS Word. Я сослался на эту страницу и добавил BitmapMissingFonts:=False. Решил проблему.

.ActiveDocument.ExportAsFixedFormat2 SaveName, wdExportFormatPDF, BitmapMissingFonts:=False

Всем спасибо!