Приветствую!
Макрос для выгрузки данных из Excel в Word. Проблема вот в чем:
Макрос прекрасно работает в версиях Excel 2016/2019. Но в Excel 2010 не может найти библиотеку Microsoft Word 16.0 Object Library – пишет MISSING. Если ручками убрать библиотеку 16.0 и поставить 14.0, то макрос запускается. Я как понял, нужно использовать позднее связывание, но куда его запилить ума не приложу.
Ругается на 3 строку (Public AppWord As Word.Application, iWord As Word.Document).
Буду признателен за помощь.
Макрос для выгрузки данных из Excel в Word. Проблема вот в чем:
Макрос прекрасно работает в версиях Excel 2016/2019. Но в Excel 2010 не может найти библиотеку Microsoft Word 16.0 Object Library – пишет MISSING. Если ручками убрать библиотеку 16.0 и поставить 14.0, то макрос запускается. Я как понял, нужно использовать позднее связывание, но куда его запилить ума не приложу.
Ругается на 3 строку (Public AppWord As Word.Application, iWord As Word.Document).
Буду признателен за помощь.
Код |
---|
Option Explicit Option Private Module Public AppWord As Word.Application, iWord As Word.Document Sub CreateDoc() Dim MyArray(), BasePath As String, iFolder As String, iTemplate As String Dim tmpArray, tmpSTR As String, iRow As Long, iColl As Long, i As Long, j As Long, q As Long Application.ScreenUpdating = 0 On Error GoTo iEnd iFolder = Range("FILE_WORD").Value: If Right(iFolder, 1) <> "\" Then iFolder = iFolder & "\" iTemplate = Range("FILE_TEMPLATE").Value: If Right(iTemplate, 1) = ";" Then iTemplate = Left(iTemplate, Len(iTemplate) - 1) BasePath = ThisWorkbook.Path & "\Result\": Call FolderCreateDel(BasePath) With Sheets("data") iRow = .UsedRange.Row + .UsedRange.Rows.Count - 1: iColl = .UsedRange.Column + .UsedRange.Columns.Count - 1 MyArray = .Range(.Cells(1, 1), .Cells(iRow, iColl)).Value End With 'создаем скрытый объект Word Set AppWord = CreateObject("Word.Application"): AppWord.Visible = False 'перебираем массив For i = 2 To iRow If MyArray(i, 1) = "ok" Then 'перебираем указанные word-шаблоны tmpArray = Split(MyArray(i, 3), ";") For q = 0 To UBound(tmpArray) tmpSTR = iFolder & tmpArray(q) & ".docx" If Len(Dir(tmpSTR)) > 0 Then Set iWord = AppWord.Documents.Open(tmpSTR, ReadOnly:=True) 'делаем замену переменных For j = 4 To iColl Call ExportWord(MyArray(1, j), MyArray(i, j)) Next j iWord.SaveAs Filename:=BasePath & MyArray(i, 2) & " - " & tmpArray(q) & ".docx", FileFormat:=wdFormatXMLDocument iWord.Close False: Set iWord = Nothing End If 'tmpSTR = "" Next q 'Erase tmpArray End If Next i AppWord.Quit: Set AppWord = Nothing 'Erase MyArray: BasePath = "": iFolder = "": iTemplate = "" Application.ScreenUpdating = 1 MsgBox "Файлы сформированы.", vbInformation Exit Sub iEnd: AppWord.Quit: Set AppWord = Nothing 'Erase MyArray: BasePath = "": iFolder = "": iTemplate = "" Application.ScreenUpdating = 1 MsgBox "При обработке данных возникла ошибка.", vbCritical End Sub |