1

Тема: Макрос подстановки текста из файла заготовок

Всем добрый день.
Для тех, кто любит ускорять свою работу, хочу предложить макрос InsertBoilerplate, который я недавно написал для работы над документом, в него часто приходилось вставлять одни и те же фрагменты-заготовки, их было штук пять.
Для работы с макросом надо подготовить документ заготовок (я его назвал boilerplates.docx). В нем я разместил две заготовки таблиц разного формата, заготовку рисунка и пару типовых абзацев. Каждый такой фрагмент в файле заготовок я отметил закладками вида
    ESP_BOILERPLATE_NNN
То есть, отметил закладками ESP_BOILERPLATE_000, ESP_BOILERPLATE_001 и т.д.
В состав решения входят два макроса:
   - InsertBoilerplate
   - InsertBoilerplateRunner
Второй макрос, который вызывается из основного, имеет параметр - имя открытого в Word файла заготовок.
Макросу InsertBoilerplate я назначил комбинацию горячих клавиш Alt+?.
Схема работы с макросом такая:
1) Открываем файл заготовок.
2) Открываем рабочий документ.
3) Находим очередное место, куда надо вставить текст одной из заготовок. Я просто набирал текст рабочего документа, и, когда возникала потребность во вставке одной из заготовок, переходил на шаг 4.
4) Ставим курсор в целевую позицию, нажимаем Alt+?. Макрос подставляет туда первую из заготовок, размещённых в файле заготовок и выделяет вставленный текст.
- Если этот текст нам подходит, то снимаем выделение, дополняем вставленный текст заготовки нужными словами и  продолжаем работу с шага 3.
- Иначе продолжаем нажимать Alt+? до тех пор, пока на целевую позицию не скопируется нужная нам заготовка.
Код макросов представлен ниже.

Sub InsertBoilerplate()
Call InsertBoilerplateRunner("boilerplates.doc*")
End Sub

Sub InsertBoilerplateRunner(Keyw_Doc As String)
'Макрос вставляетв рабочий документ следующий по порядку образец из файла образцов
'Bolierplates.docx. Все образцы в файле образцов имеют разметку закладками с префиксоим
'в имени "ESP_BOILERPLATE_"
'Пользователь нажимает комбинацию клавиш,отвечающих макросу InsertBoilerplate.
'1.Макрос проверяет, загружен ли в Word файлобразцов. Если нет, то конец работы макроса.
'2.Макрос проверяет, что документ образцов содержит по меньшей мере одну закладку с
'префиксорм имени "ESP_BOILERPLATE_".  Если нет, то конец работы макроса.
'3.Макрос проверяет, входит ли в выделенный текст рабочего документа
'закладка "ESP_CURRENT_BOILERPLATE":
'   - если не входит (а),то макрос удаляет закладку с таким именем из основного
'     документа и создает такую закладку заново для выделенного текста и переходит к
'     сканированию закладок документа образцов с начала.
'   - если такая закладка входит в выделенный текст рабочего документва (b), то переход
'     к продолжению сканирования закладок документа образцов.
'3.Макрос сканирует закладки в документе образцов по префиксу имени
'"ESP_CURRENT_BOILERPLATE".
'   - Если  на предыдущем шаге имела место ситуация (a), то из файла
'     образцов берется первая по счету закладка с префиксом "ESP_BOILERPLATE" и
'     ее содержимое копируется в рабочий документ на место закладки
'     "ESP_CURRENT_BOILERPLATE", с выделением вставленного контента.
'   - Если  на предыдущем шаге имела место ситуация (b), то из файла
'     образцов берется следующая по порядку закладка с префиксом "ESP_BOILERPLATE" и
'     ее содержимое копируется в рабочий документ на место закладки
'     "ESP_CURRENT_BOILERPLATE", с выделением вставленного контента.
'Если при выборе очередной закладки в файле образцов выясняется, что новых закладок
'c префиксом в имени "ESP_BOILERPLATE_" больше не обнаружено, то выбирается опять первая
'такая закладка.
'Номер текущего образца ведется в глобальной переменной NextBoilerplateNumber.
'Таким образом, пользователь, нажимая последовательно комбинацию клавиш вызова макроса,
'последовательно подставляет в рабочяий документ образцы из файла образцов.
Dim Main_Document, Keyw_Document
Dim kwdoc_found As Boolean
Dim errflag As Long
Dim wbm() As Long
Dim iwbm As Long
Dim nwbm As Long
Dim abmk As Bookmark
Dim wbm_cnt As Long
Dim iwbmk As Long
Dim oSource As Document
Dim oRng As Range
Dim srcbmkrg As Range
Dim addedbmkname As String
Dim first_boilerplate_bmk_num As Long
Const ESP_BOILERPLATE As String = "ESP_BOILERPLATE_"
Const ESP_CURRENT_BOILERPLATE As String = "ESP_CURRENT_BOILERPLATE"

'1. Открыт ли файл орбразцов
Main_Document = ActiveDocument.Name
kwdoc_found = False
For Each doc In Documents
    If UCase$(doc.Name) Like UCase$(Keyw_Doc) Then
        kwdoc_found = True
        Keyw_Doc = doc.Name
    End If
Next doc
If kwdoc_found <> True Then
   MsgBox Keyw_Doc & " file is not loaded"
   GoTo e_IB
End If
'2.Есть ли в документе образцов необходимые образццы?
iwbm = 0
first_boilerplate_bmk_num = 0
wbm_cnt = Documents(Keyw_Doc).Bookmarks.count
If wbm_cnt > 0 Then
    For iwbmk = 1 To wbm_cnt
        Set abmk = Documents(Keyw_Doc).Bookmarks(iwbmk)
        If InStr(UCase(abmk.Name), ESP_BOILERPLATE) = 1 Then
            iwbm = iwbm + 1
            If first_boilerplate_bmk_num = 0 Then
                first_boilerplate_bmk_num = iwbmk
            End If
            ReDim Preserve wbm(1 To iwbm)
            wbm(iwbm) = iwbmk 'сбор номеров закладок образцов в док-те образцов
        End If
    Next
End If
nwbm = iwbm
If nwbm = 0 Then
   MsgBox Keyw_Doc & " does not contain boilerplates"
   GoTo e_IB
End If
'3. Проверка выделенного текста на закладку "ESP_CURRENT_BOILERPLATE"
If Selection.Range.Bookmarks.Exists(ESP_CURRENT_BOILERPLATE) Then
    o = 0
    On Error Resume Next
    errflag = 0
    NextBoilerplateNumber = NextBoilerplateNumber + 1
    errflag = err.Number
    On Error GoTo 0
    If errflag <> 0 Then
        NextBoilerplateNumber = first_boilerplate_bmk_num ''' 1
    Else
        If NextBoilerplateNumber > nwbm Then
            NextBoilerplateNumber = first_boilerplate_bmk_num ''' 1
        End If
    End If
Else
    o = 0
    'Добавление закладки "ESP_CURRENT_BOILERPLATE"
    ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:=ESP_CURRENT_BOILERPLATE
    NextBoilerplateNumber = first_boilerplate_bmk_num ''' 1
End If
'4.Копирование контекста очередного образца в рабочий документ
Set oRng = Selection.Range 
Set oSource = Documents(Keyw_Doc)
Set srcbmkrg = oSource.Range( _
    start:=oSource.Bookmarks(NextBoilerplateNumber).Range.start, _
    end:=oSource.Bookmarks(NextBoilerplateNumber).Range.end _
    )
oRng.FormattedText = srcbmkrg
addedbmkname = oSource.Bookmarks(NextBoilerplateNumber).Name

'Удаление добавленной в результате копирования закладки и
'Удаление/Добавление закладки "ESP_CURRENT_BOILERPLATE"
On Error Resume Next
ActiveDocument.Bookmarks(ESP_CURRENT_BOILERPLATE).Delete
ActiveDocument.Bookmarks(addedbmkname).Delete
ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:=ESP_CURRENT_BOILERPLATE
On Error GoTo 0
'Выделение добавленного текста
oRng.Select
e_IB:
End Sub

2

Re: Макрос подстановки текста из файла заготовок

yshindin пишет:

. . .
Код макросов представлен ниже.
. . .

Прошу прощения, забыл упомянуть, что для правильной работы макросов на уровне публичного доступа необходимо указать (напр., в начале того же модуля, который содержит представленные макросы) объявление:

Public NextBoilerplateNumber As Long