Fck_This пишет:Fck_This пишет:Вам поможет этот сайт:
внешняя ссылка
Сначала необходимо заменить 2 и более знаков абзаца подряд на 1 знак абзаца. (это записывается макрорекордером
... (это записывается макрорекордером "Макрос - записать" + выполняем действия с подстановочными знаками + останавливаем запись) Далее открываем получившийся макрос и перед End Sub добавляем перебор знаков параграфа. Но возникает вопрос "Что если за жирным текстом снова идёт жирный текст? Сколько знаков абзаца должно быть?" и ещё "Что если за жирным текстом идёт курсив или наоборот? Сколько знаков абзаца должно быть?"
Этот код представляет собой перебор знаков абзаца, но его будет необходимо дополнить.
Dim bBold As Boolean
Dim sBold, sItalic As String
sBold = Chr(13) & Chr(13) & Chr(13) 'Три знака абзаца вместо одного - для жирного
sItalic = Chr(13) & Chr(13) 'Два вмето одного - для курсива (можно менять как угодно)
bBold = False
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Wrap = wdFindContinue
.Forward = True
.Text = Chr(13)
Do While .Execute = True
If Selection.Characters(1).Next.Bold = True Then
If bBold = False Then
bBold = True
GoTo SkipLine
End If
'Условие "Если следующий за абзацем текст - жирный"
Selection.Range.Text = sBold
Selection.Collapse Direction:=wdCollapseEnd
ElseIf Selection.Characters(1).Next.Italic = True Then
'Условие "Если следующий за абзацем текст - курсив"
Selection.Range.Text = sItalic
Selection.Collapse Direction:=wdCollapseEnd
ElseIf Selection.Characters(1).Previous.Bold = True Then
Selection.Range.Text = sItalic
Selection.Collapse Direction:=wdCollapseEnd
'Предыдущий - жирный
ElseIf Selection.Characters(1).Previous.Italic = True Then
'Предыдущий - курсив
End If
SkipLine:
Loop
End With
Но стоит вопрос "как определить, что этот текст - имя автора? Я не увидел формата, в котором оно употребляться. Предложил бы по вхождению двух точек, например. Ещё лучше имя автора делать специальным стилем и определять по стилю.
Спасибо что ответили.
1. На вопрос "как определить, что этот текст - имя автора?":
Имя автора жирный, после него стоит вергуль. А внизу в абзаце текст в курсиве (звание автора).
2. Этот кусок макроса я в ворде попробовал. Но выдал ошибки.
3. Вот мой макрос, но я не мог справляться с абзацами. Есть мелкие ошибки:
Sub Saytga_moslash()
'
' Saytga_moslash
'
Selection.Find.ClearFormatting
Selection.Find.Font.Italic = True
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Font.Italic = True
With Selection.Find
.Text = "^p^p"
.Replacement.Text = "^l^l"
.Wrap = wdFindContinue
.MatchWildcards = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^p^p"
.Replacement.Text = "^p"
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "¢à"
.Replacement.Text = ChrW(1170) & "à"
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "¢à"
.Replacement.Text = ChrW(1170) & "à"
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "* * *"
.Replacement.Text = "^p* * *"
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "***"
.Replacement.Text = "^p* * *"
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Font.Bold = True
Selection.Find.Replacement.Font.Bold = True
With Selection.Find
.Text = ""
.Replacement.Text = "^p^&"
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Font.Italic = True
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^p"
.Replacement.Text = "^p^p^p^&^p^p^p"
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^p^p^p"
.Replacement.Text = "^p"
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "^l^l"
.Replacement.Text = "^p^p"
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "^l"
.Replacement.Text = "^p"
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "(^0013){3;}([!^0013])"
.Replacement.Text = "^p^p\2"
.Wrap = wdFindContinue
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = " ^p"
.Replacement.Text = "^p"
.Wrap = wdFindContinue
.MatchWildcards = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "([!^0013])(^0013){3;}"
.Replacement.Text = "\1^p^p"
.Wrap = wdFindContinue
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "(^0013){3;}"
.Replacement.Text = "^p^p"
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Font.Italic = False
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ",^p^p"
.Replacement.Text = ",^p"
.Wrap = wdFindContinue
.MatchWildcards = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
Selection.EndKey Unit:=wdStory
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
End Sub