Я ищу макрос, который запускает и запускает строительный блок для определенного текста в документах MS Word.
мне нравится этот код ниже, полученный с этого форума. Но меня интересует, как найти конкретный текст и автоматически запустить этот макрос.
Например: если в моих документах Word есть текст «MyBB», то мне нужен строительный блок с именем «MyBB», который появится автоматически после запуска кода.
я сохранил много строительных блоков и активировал их с помощью клавиши F3 для определенного текста в повседневной работе.
Нужна помощь в изменении кода, который запускает упомянутое выше
Sub InsertMyBB()
'
' Assumes that the Building Block is of the type AutoText (wdTypeAutoText) in Category "General"
' See https://msdn.microsoft.com/en-us/library/bb243303(v=office.12).aspx
'
' This is based in part upon contributions from Greg Maxey and Jay Freedman - any errors remain mine
' Written by Charles Kenyon February 2016
'
Dim sBBName As String
Dim sTempName As String
Dim oBB As BuildingBlock
sBBName = "MyBB" 'use the name of your building block instead of "MyBB"
sTempName = ThisDocument.FullName ' puts name and full path of template in string variable
On Error Resume Next
Application.Templates.LoadBuildingBlocks ' thank you Timothy Rylatt
Set oBB = Application.Templates(sTempName).BuildingBlockTypes(wdTypeAutoText) \_
.Categories("General").BuildingBlocks(sBBName)
If Err.Number = 0 Then
oBB.Insert Selection.Range, True
Else
MsgBox Prompt: = "The Building Block '" & sBBName & "' cannot be found in " & \_
ThisDocument.Name & ".", Title: = "Didn't Work!"
End If
On Error GoTo 0
lbl_Exit:
Exit Sub
End Sub
Sub INSERTTABLE()
Dim strSearch As String
strSearch = "3000"
Selection.Find.ClearFormatting
With Selection.Find
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.MatchCase = True
.Format = True
.Text = strSearch
.Execute
Do While Selection.Find.Found = True And icount < 1000
icount = icount + 1
Selection.HomeKey unit:=wdStory
Selection.Find.Execute
Selection.Range.InsertAutoText
Loop
strSearch = "5000"
Selection.Find.ClearFormatting
With Selection.Find
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.MatchCase = True
.Format = True
.Text = strSearch
.Execute
Do While Selection.Find.Found = True And icount < 1000
icount = icount + 1
Selection.HomeKey unit:=wdStory
Selection.Find.Execute
Selection.Range.InsertAutoText
Loop
End With
End With
End Sub
Учитывая ссылку на документ и массив имен строительных блоков, этот метод должен заменить имя каждого строительного блока соответствующим содержимым для всех экземпляров, найденных в документе:
Sub CheckAllBB()
'
' Assumes that the Building Block is of the type AutoText (wdTypeAutoText) in Category "General"
' See https://msdn.microsoft.com/en-us/library/bb243303(v=office.12).aspx
'
' This is based in part upon contributions from Greg Maxey and Jay Freedman - any errors remain mine
' Written by Charles Kenyon February 2016
'
Dim sBBName As Variant, sTempName As String
Dim oBB As BuildingBlock, oBBT As BuildingBlockType, doc As Document
sTempName = ThisDocument.FullName
Application.Templates.LoadBuildingBlocks ' thank you Timothy Rylatt
Set oBBT = Application.Templates(sTempName).BuildingBlockTypes(wdTypeAutoText)
Set doc = ActiveDocument 'the document with placeholders to be replaced
'loop over building block names
For Each sBBName In Array("MyBB1", "MyBB2", "MyBB3")
Set oBB = Nothing 'reset to nothing
On Error Resume Next
'Try to get the building block
Set oBB = oBBT.Categories("General").BuildingBlocks(sBBName)
On Error GoTo 0
If Not oBB Is Nothing Then 'got the building block?
ReplaceAllBB doc, oBB 'perform the replacement(s)
Else
MsgBox "The Building Block '" & sBBName & "' cannot be found in " & _
ThisDocument.Name & ".", vbExclamation, "Building Block not found"
End If
Next sBBName
End Sub
Sub ReplaceAllBB(doc As Document, BB As BuildingBlock)
Dim allBB As New Collection, rng As Range
Set rng = doc.Range
With rng.Find
.Forward = True
.Text = BB.Name
.MatchWholeWord = True
Do While .Execute
allBB.Add rng.Duplicate
Loop
End With
Debug.Print "Found " & allBB.Count; " instances of '" & BB.Name & "'"
For Each rng In allBB
BB.Insert rng, True
Next rng
End Sub