Перенос макроса объединения файлов word в шаблон normal.dot

Старая форма входа

Страница 1 из 1 1
Модератор форума: _Boroda_, китин

maximich

Дата: Пятница, 12.11.2021, 14:43 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 37

Репутация: 1 ±

Замечаний: 0% ±

Excel 2013

Уважаемые форумчане, здравствуйте!
Помогите пожалуйста с решением проблемы.
В моем рабочем документе word есть макрос для объединения файлов word в один файл.
Когда я его запускаю из рабочего файла (в котором он сохранен), он отлично работает, но как только я его перенес в шаблон word - normal.dotm
он выдает следующую ошибку:

Сам код макроса следующего вида:
[vba]

Код

Sub Объединение_файлов()
    Dim avFiles, lr As Long
    Dim docAct As Document, docNow As Document

    With Application.FileDialog(msoFileDialogFilePicker)
        .InitialFileName = "*.doc*"
        .AllowMultiSelect = True
        If .Show = False Then Exit Sub
        Set docAct = ActiveDocument
        For lr = 1 To .SelectedItems.Count
            Set docNow = Documents.Open(.SelectedItems(lr))
            docNow.Range.Copy
            docAct.Range(docAct.Range.End - 1).Paste
            If lr < .SelectedItems.Count Then docAct.Range(docAct.Range.End - 1).InsertBreak Type:=wdSectionBreakNextPage
            docNow.Close 0
        Next lr
    End With
End Sub

[/vba]

Заранее благодарю!

Ответить

Pelena

Дата: Пятница, 12.11.2021, 15:28 | Сообщение № 2

Группа: Админы

Ранг: Местный житель

Сообщений: 19403

Репутация: 4555 ±

Замечаний: ±

Excel 365 & Mac Excel

Попробуйте так
[vba]

Код

Sub Объединение_файлов()
    Dim avFiles, lr As Long
    Dim docAct As Document, docNow As Document

    With Application.FileDialog(msoFileDialogFilePicker)
        .InitialFileName = "*.doc*"
        .AllowMultiSelect = True
        If .Show = False Then Exit Sub
        Documents.Add
        Set docAct = ActiveDocument
        For lr = 1 To .SelectedItems.Count
            Set docNow = Documents.Open(.SelectedItems(lr))
            docNow.Range.Copy
            docAct.Range(docAct.Range.End - 1).Paste
            If lr < .SelectedItems.Count Then docAct.Range(docAct.Range.End - 1).InsertBreak Type:=wdSectionBreakNextPage
            docNow.Close 0
        Next lr
    End With
End Sub

[/vba]