Здравствуйте уважаемые "жильцы" форума, подскажите, как сделать такую вещь.
Макрос работает из файла excel, программа представляет собой код который из каталога выбирает позиции и создает из них предложение. Для сопровождения этого предложения необходимо создать технический лист. Задумка такова - в отдельных файлах word уже лежит информация по каждой позиции, код должен:
1. Создать файл word (например Технический_лист.doc) и открыть его
2. Открыть файл word с указанным именем (например "Кран1.doc) скопировать из него всю информацию и вставить её в "Технический_лист.doc", закрыть файл "Кран1.doc
3. Открыть файл word с указанным именем (например "Кран2.doc) скопировать из него всю информацию и вставить её в "Технический_лист.doc" , закрыть файл "Кран2.doc
4...И т.д. циклически для каждого пункта предложения.
5. Сохранить и закрыть файл Технический_лист.doc
Вот я пытался танцевать танцы с бубном, но ничего не получается:
Макрос
Sub SozdatTechSheet(CreatedFileNameTech As String)
Dim OpenWord, NewWordFile, CatWordFile, OSel, OselNew As Object
Dim CatalogDir, CatalogOborudovanie, CatalogMateriali, LookedForFileName, InDex As String
Dim i As Byte
Dim metka As Integer
Dim arr() As Variant
CatalogDir = ThisWorkbook.Path & "\" & "Каталог"
CatalogOborudovanie = CatalogDir & "\" & "Оборудование"
CatalogMateriali = CatalogDir & "\" & "Материалы"
Set OpenWord = CreateObject("Word.Application")
Set NewWordFile = OpenWord.documents.Add(Template:="Normal", NewTemplate:=False, DocumentType:=0, Visible:=False)
NewWordFile.SaveAs2 FileName:=CreatedFileNameTech, FileFormat:=wdFormatXMLDocument, LockComments:=False
metka = 0
metka = Predlozhenie.PoiskMetki(metka)
arr = Predlozhenija.Range("B" & metka & ":B100").Value
Do While arr(i + 1, 1) = "Metka" 'Цикл выполняется до тех пор пока значение i совпадает с меткой
InDex = Predlozhenija.Range("C" & metka + i)
InDex = CatalogOborudovanie & "\" & InDex & FolderNameRazd & "*.docx"
If Dir(InDex) <> "" Then
LookedForFileName = CatalogOborudovanie & "\" & Dir(InDex)
Set CatWordFile = OpenWord.documents.Open(LookedForFileName)
Set OSel = CatWordFile.Range()
OSel.Copy
Set OselNew = NewWordFile.Range()
OselNew.PasteAndFormat (wdFormatOriginalFormatting)
OselNew.InsertBreak Type:=wdPageBreak
CatWordFile.Close savechanges:=wdDoNotSaveChanges
End If
i = i + 1
Loop
NewWordFile.Close savechanges:=wdSaveChanges, OriginalFormat:=wdOriginalDocumentFormat
End Sub
Заранее благодарен за помощь.
Не ответ на ваш вопрос, просто увидел неточность у вас.
В VBA есть особенность - нужно указывать тип данных для каждой переменной, а не один раз в конце.
Если не указывать для переменной тип данных, то переменная будет иметь тип данных "Variant".
Правильно так, если у всех переменных должен быть тип данных "Object":
Dim OpenWord As Object, NewWordFile As Object, CatWordFile As Object, OSel, OselNew As Object
Приложите эксель-файл, который участвует в этом макросе.
В файле можете оставить только те данные, которые участвуют в макросе.
Вот файл excel и структура каталогов и файлов.
[вложение удалено администратором]
Это не ответ на вопрос, а замечание. Хотя и это тоже вызовет ошибку.
Экселю не известны вордовские константы:
savechanges:=wdDoNotSaveChanges
Правильно так:
savechanges:=0
Спасибо за замечания насчет констант я даже как-то не подумал.
Сделал, смотрите файл.
[вложение удалено администратором]
Спасибо большое всё работает. Огромное спасибо Администратору форума, вы значительно упростили мне жизнь (и моему менеджеру в том числе).