Тема: Макрос подстановки текста из файла заготовок
Всем добрый день.
Для тех, кто любит ускорять свою работу, хочу предложить макрос 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