Копировать из Excel Вставить в Word - PullRequest
Новая
       20

Копировать из Excel Вставить в Word

0 голосов
/ 26 января 2020

В Excel у меня есть около 20 листов с 20 диаграммами на каждом, которые мне нужно скопировать / вставить в документы Word. Одно слово сделать c за лист Excel. Я нашел эту статью с решением, которое я изменил, чтобы принять ChartObject в качестве параметра, чтобы мне не приходилось думать о том, какая диаграмма копируется. Я получаю следующую ошибку во время выполнения в последней строке, где он вызывает PasteSpecial в функции CopyChart2Word ():

enter image description here

Что не очень полезно, потому что это не говорит мне, что не так. Но диаграмма вставляется в документ Word с отсутствующей половиной точек данных.

Код: 

Public Function moveCharts()
  Dim i As Integer
  Dim name As String
  Dim ChtObj As ChartObject
  Dim dummy As Variant

  initGlobals
  For i = 0 To UBound(employees)
    name = employees(i)
    For Each ChtObj In Worksheets(name).ChartObjects
        dummy = CopyChart2Word(ChtObj)
    Next ChtObj
  Next i
End Function

Public Function CopyChart2Word(chartObj As ChartObject)
  Dim wd As Object
  Dim ObjDoc As Object
  Dim FilePath As String
  Dim FileName As String
  FilePath = "C:\Users\name\Desktop"
  'Empty document for now
  FileName = "Template.docx"

  'check if template document is open in Word, otherwise open it
  On Error Resume Next
  Set wd = GetObject(, "Word.Application")
  If wd Is Nothing Then
    Set wd = CreateObject("Word.Application")
    Set ObjDoc = wd.Documents.Open(FilePath & "\" & FileName)
  Else
    On Error GoTo notOpen
    Set ObjDoc = wd.Documents(FileName)
    GoTo OpenAlready
    notOpen:
    Set ObjDoc = wd.Documents.Open(FilePath & "\" & FileName)
  End If
  OpenAlready:
  On Error GoTo 0

  'find Bookmark in template doc
  wd.Visible = True
  'ObjDoc.Bookmarks("Bookmark1").Select

  'copy chart from Excel
   chartObj.chart.ChartArea.Copy

   'insert chart to Bookmark in template doc
   'wdPasteMetafilePicture didn't work so I used the numeric value 3
   'wdInLine didn't work so I used the numeric value 0
   wd.Selection.PasteSpecial Link:=False, _
   DataType:=3, _
   Placement:=0, _
   DisplayAsIcon:=False
 End Function

Ссылка на образец диаграммы .

1 Ответ

0 голосов
/ 26 января 2020

Я подозреваю, что ошибка может быть вызвана тем, что одновременно открываются различные варианты Word. Чтобы исключить эту возможность, я рекомендую разобраться в способах работы с Word и документами. Логика c вашего кода немного запутана. Пожалуйста, попробуйте это вместо этого. 

On Error Resume Next
Set Wd = GetObject(, "Word.Application")
If Err Then Set Wd = CreateObject("Word.Application")

On Error Resume Next
Set ObjDoc = Wd.Documents(Filename)
If Err Then Set ObjDoc = Wd.Documents.Open(FilePath & "\" & Filename)

On Error GoTo 0

Интересно, зачем вам нужно Wd.Visible = True. Это должно быть видно по умолчанию. Возможно, окно не ActiveWindow, однако. На самом деле Word не может быть активным приложением. Я не думаю, что это имеет значение для кода.

Но это должно иметь большое значение для объекта Selection. Только ActiveWindow может иметь Selection. Поэтому, если у вас есть Excel, откройте и запустите код, вы не сможете получить доступ к объекту Selection в Word. И наоборот, если вы откроете Word и сделаете выбор, а затем перейдете в Excel, объект Selection будет потерян. Это также может привести к фатальной ошибке. Просто следуйте правилу: «Никогда Select ничего в VBA [до последней строки вашего кода].

...