Function Testword (worddoc) As textandsign' абзацы с красной строки
    On Error Goto ErrH
    
    Dim slovo As Variant
    Dim sText As String
    Dim sign As String
    
    Dim obtextandsign As New textandsign
    
    Set Bookmark = worddoc.Bookmarks
    Print "Закладок: " & Cstr(worddoc.Bookmarks.Count)
    If worddoc.Bookmarks.Count  <> 4 Then
        Messagebox "Некорректный файл с word шаблоном!"
        worddoc.Close
        Exit Function
    End If
    
    sText   =  "текст"
    
    worddoc.Selection.GoToEditableRange (wdEditorEveryone)
    worddoc.Selection.GoToEditableRange (wdEditorEveryone)
    worddoc.Selection.GoToEditableRange (wdEditorEveryone)
    worddoc.Selection.GoToEditableRange (wdEditorEveryone)
    worddoc.Selection.GoToEditableRange (wdEditorEveryone)
    sText   =  worddoc.Selection.text
    Messagebox sText
    
    sAppeal$ = sText
    sAppeal$   =  Strclean (sAppeal$)
    sText   =   |<p align="center">| + sAppeal$  + "</p>"+ sText
    
    mStart% = Bookmark(2).Range.Start     '  Подпись  руководителя
    mEnd%= Bookmark(4).Range.End
    Set myRange = worddoc.Range(  mStart%,mEnd%   )
    sign = Cstr(myRange.text)
    sign   =  Strclean (sign)       
    
    obtextandsign.obText =  sText 
    obtextandsign.obSign = sign
    Set    Testword = obtextandsign
    
    worddoc.Close
    
    Exit Function
ErrH:
    Print "Ошибка ф-ции  TeStword  " & Error(Err) & " в строке " & Erl    
    
End Function

Sub TEGHTML2()
'
' TEGHTML2 Макрос

  Selection.WholeStory
    Selection.GoToEditableRange (wdEditorEveryone)
    Selection.GoToEditableRange (wdEditorEveryone)
    Selection.GoToEditableRange (wdEditorEveryone)
    Selection.GoToEditableRange (wdEditorEveryone)
    
    Selection.Find.ClearFormatting
    Selection.Find.Font.Bold = True
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "(?)"
        .Replacement.Text = "<b>\1</b>"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll  ' работает
    
End Sub

Sub Jirno()
'
'
On Error GoTo ErrHandler:

Set Bookmark = ActiveDocument.Bookmarks
 mStart% = Bookmark(1).Range.Start + 1
 mEnd% = Bookmark(2).Range.End - 2
 
Dim myRange As Range
 Set myRange = ActiveDocument.Range(mStart%, mEnd%)
  myRange.Select
  


  'Selection.InsertAfter "РАБОТАЕТ ДОБАВЛЕНИЕ ТЕКСТА"  
  
    Selection.Find.ClearFormatting
    Selection.Find.Font.Bold = True
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "(<*>)"
        .Replacement.Text = "<b>\1</b>"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll  ' работает
    
        Exit Sub
ErrHandler:
MsgBox Err.Number
    Resume Next
End Sub

Set myRange = worddoc.Range(  mStart%,mEnd%   )
    
    Dim rngResult As Variant
    
    Set rngResult  = myRange.Duplicate  ' клонирует имеющийся текстовый диапазон
    rngResult.Find.ClearFormatting ' очищает форматирование внутри объекта Find 
    rngResult.Find.Font.Bold = True
    rngResult.Find.Replacement.ClearFormatting   ' Сброс форматирования из предыдущих операций поиска.
    
    rngResult.Find.Text = "(<*>)"
    rngResult.Find.Replacement.Text = "<b>\1</b>"  ' на что заменяем
    rngResult.Find.Forward = True ' поиск по всему документу вперед
    rngResult.Find.Wrap = wdFindContinue ' продолжать поиск, если анчали не с  начала документа
    rngResult.Find.Format = True ' включить форматирование
    rngResult.Find.MatchCase = False ' не учитывать регистр
    rngResult.Find.MatchWholeWord = False ' искать части слов
    rngResult.Find.MatchAllWordForms = False ' учитывать словоформы
    rngResult.Find.MatchSoundsLike = False  ' учитывать похожие слова
    rngResult.Find.MatchWildcards = True '  подстановочные знаки - флажок в (Edit menu) ворда
    
    rngResult.Find.Execute

Sub Click(Source As Button)
    Dim ws As New NotesUIWorkspace
    Dim udoc As NotesUIDocument
    Set udoc = ws.CurrentDocument
    Dim doc As NotesDocument
    Set doc = udoc.Document
    
    Dim worddoc As Variant
    Dim WordApp As Variant
    Set WordApp = CreateObject ("Word.Application")
    WordApp.Visible=False
    mypatch$ = "C:\XML\123.docx"
    Set worddoc = WordApp.Documents.Open(mypatch$)    
    worddoc.Select
    Set myRange = worddoc.Content
    Msgbox Cstr(myRange.Text)
    
    myRange.Find.Text = "b"
    myRange.Find.Replacement.Text = "<b>"
    myRange.Find.ClearFormatting ' очищает форматирование внутри объекта Find 
    'myRange.Find.Font.Bold = True
    myRange.Find.Replacement.ClearFormatting   ' Сброс форматирования из предыдущих операций поиска.
    myRange.Find.Forward = True ' поиск по всему документу вперед
    myRange.Find.Wrap = wdFindContinue ' продолжать поиск, если анчали не с  начала документа
    myRange.Find.Format = True ' включить форматирование
    myRange.Find.MatchCase = False ' не учитывать регистр
    myRange.Find.MatchWholeWord = False ' искать части слов
    myRange.Find.MatchAllWordForms = False ' учитывать словоформы
    myRange.Find.MatchSoundsLike = False  ' учитывать похожие слова
    'myRange.Find.MatchWildcards = True '  подстановочные знаки - флажок в (Edit menu) ворда
    myRange.Find.Execute ,,,,,,,,, wdReplaceAll
    Msgbox Cstr(myRange.Text)
    myRange.Text = "===="
    
    
    'Dim myList  List As String
    'myList  ("b") = "<b>"
    'myList  ("1") = "<1>"
    'xxxxxxxxxx = ReplaceByTemplate(myList , worddoc) 
    
    worddoc.Close
    WordApp.Quit
    Call doc.Save( False, True )
    Call udoc.Close
End Sub

Sub test()
'

    Selection.Find.ClearFormatting
    Selection.Find.Font.Bold = True
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "(<*>)"
        .Replacement.Text = "<b>\1</b>"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

    mStart% = Bookmark(1).Range.Start    '  WORD ТЕКСТ
    mEnd%= Bookmark(2).Range.End
    Print mStart% 
    Print mEnd%
    Set myRange = worddoc.Range(  mStart%,mEnd%   )
    
    'objWords = myRange.Words ' ЖИРНЫЙ ШРИФТ <B>
    Print "Слов в Word тексте: "  & Cstr(worddoc.Words.Count )
    Print "Слов Word в myRange: "  & Cstr(myRange.Words.Count )
    For iCount = myRange.Words.Count To 1 Step -1
    '    Print "iCount " &  iCount
        Set slovo = myRange.Words(iCount)
        If  Asc(slovo.Text) = 13 Then
            Print "плохой символ"
        Else
            If slovo.Bold = True Then
                Print "slovo " & slovo.Text 
                slovo.Text = "<b>" & Trim$(slovo.Text) & "</b> "
            Else
                For xCount = slovo.Characters.Count To 1 Step -1
                    Set bukva = slovo.Characters(xCount)
                    If bukva.Bold = True Then
                        Print "bukva " & slovo.Text 
                        bukva.Text = "<b>" & Trim$(bukva.Text) & "</b>"
                    End If
                Next
            End If
        End If
        
    Next

Dim Slovo As String



For i = 1 To ActiveDocument.Range.Words.Count
 Slovo = ActiveDocument.Words.Item(i)

  If ActiveDocument.Words.Item(i).Font.Bold = True Then
ActiveDocument.Words.Item(i) = "<b>" & ActiveDocument.Words.Item(i) & "</b>"

Selection.EndOf
End If
Next

'For Each Slovo In ActiveDocument.Words
'If Slovo.Font.Size = 14 Then
Slovo.InsertAfter ("***")
End If
Next

Sub Click(Source As Button)
    Dim ws As New NotesUIWorkspace
    Dim udoc As NotesUIDocument
    Set udoc = ws.CurrentDocument
    Dim doc As NotesDocument
    Set doc = udoc.Document
    
    Dim worddoc As Variant
    Dim WordApp As Variant
    Set WordApp = CreateObject ("Word.Application")
    WordApp.Visible=False
    mypatch$ = "C:\XML\123.docx"
    Set worddoc = WordApp.Documents.Open(mypatch$)    
    worddoc.Select
    
    Set myRange = worddoc.Content
    'Msgbox Cstr(myRange.Text)    
    
    Forall  slovo In worddoc.Words
        If slovo.Font.Bold = True Then
            Print slovo.text  & " жирно"
        End If
        
    End Forall
    
    '    For i% = 1 To Len(myRange.Text)
    '        xxx = worddoc.Range (i%,i%+1).Text
    '        Print  Cstr(xxx)
    '    Call rtitem.AppendText (Cstr(xxx))
    '    Next
    
    
    worddoc.Close
    WordApp.Quit
    Call doc.Save( False, True )
    Call udoc.Close
End Sub

Sub Click(Source As Button)
    
    Dim worddoc As Variant
    Dim WordApp As Variant
    Dim rnsg As Variant
    
    Set WordApp = CreateObject ("Word.Application")
    WordApp.Visible=False
    mypatch$ = "C:\XML\123.docx"
    Set worddoc = WordApp.Documents.Open(mypatch$)    
    worddoc.Select
    
    Set myRange = worddoc.Content
    Msgbox Cstr(myRange.Text)
    
    worddoc.Close
    WordApp.Quit
    
End Sub

sText$ = ""
Set Par =myRange.Paragraphs
Forall xxx In Par
sText$   = sText$ + {<p>} + Cstr(xxx.range.text)        + {</p>}
End Forall