Применить стиль

[Посетитель 29.10.2022]

Добрый день!
Подскажите как сделать такой вариант:
1. из документа образец.docx копируем текст в документ стиль чистовик.docm (в нем стиль и макрос)
2. обрабатываем вставленный текст макросом Sub ПрименитьСтиль() который в документе стиль чистовик.docm

[Администратор]

Нужно сделать по такому же принципу, как в этой теме: https://forumvba.ru/index.php?topic=2216.msg13188#msg13188, в сообщении #9?

[Посетитель 29.10.2022]

Да. Этот вариант отличный. Пробовала, сама. Не получилось так(

[Администратор]

Здесь укажите полное имя файла "образец.docx":
Set DocОбразец = Documents.Open("C:\Users\User\Desktop\образец.docx")

Предполагается, что перед запуском макроса активным документом является файл "стиль чистовик.docm".
Предполагается, что перед запуском макроса файл "образец.docx" закрыт.

Просто запустите этот макрос, он откроет образец, скопирует из него данные в активный файл, закроет образец и обработает данные в активном файле.

Макрос

Sub ПрименитьСтиль()
   
    Dim DocAct As Document, DocОбразец As Document
   
    Set DocAct = ActiveDocument
    Set DocОбразец = Documents.Open("C:\Users\User\Desktop\образец.docx")
    DocОбразец.Range.Copy
    DocAct.Range.PasteAndFormat wdFormatOriginalFormatting
    DocОбразец.Close SaveChanges:=False
   
    DocAct.Activate
   
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "а"
        .Replacement.Text = "а" & ChrW(8203)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Style = ActiveDocument.Styles("Чистовик Знак")
    With Selection.Find
        .Text = ChrW(8203)
        .Replacement.Text = ChrW(8203)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
   
End Sub

[свернуть]

[Посетитель 29.10.2022]

Вы волшебник!
То что надо, спасибо большое Вам.