1

Тема: Знак абзаца перед курсив и жирный

Здравствуйте,
Как перед курсивным и жирным абзацем поставить знак абзаца и не позволять 2 и больше абзаца после текста.
1. Перед жирным текстом добавить 2 знака абзаца, после 1 знак абзац.
2. Перед автором (жирный) 1 знак абзаца, после не добавить абзаца.
3. Перед первым жирным абзацем не поставить знаки абзаца.

Пример в изображении.

Post's attachments

Для макроса.pdf 116.99 Кб, 4 скачиваний с 2017-12-27 

You don't have the permssions to download the attachments of this post.

2

Re: Знак абзаца перед курсив и жирный

Вам поможет этот сайт:
внешняя ссылка
Сначала необходимо заменить 2 и более знаков абзаца подряд на 1 знак абзаца. (это записывается макрорекордером

Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871

3

Re: Знак абзаца перед курсив и жирный

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

Но стоит вопрос "как определить, что этот текст - имя автора? Я не увидел формата, в котором оно употребляться. Предложил бы по вхождению двух точек, например. Ещё лучше имя автора делать специальным стилем и определять по стилю.

Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871

4

Re: Знак абзаца перед курсив и жирный

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

5

Re: Знак абзаца перед курсив и жирный

Fck_This пишет:

Вам поможет этот сайт:
внешняя ссылка
Сначала необходимо заменить 2 и более знаков абзаца подряд на 1 знак абзаца. (это записывается макрорекордером


Спасибо.
Я этот сайт и другие сайты видел. Но решение для моего вопроса не нашёл.

6

Re: Знак абзаца перед курсив и жирный

Если актуально и по делу, то задача решается созданием стилей и редактирование документа с применением созданных стилей (вложенный файл, как то так).

Post's attachments

Document1.docx 22.74 Кб, 2 скачиваний с 2018-01-08 

You don't have the permssions to download the attachments of this post.
"Ты не умничай, ты пальцем покажи"
"Кто поработал с многоуровневым списком в Ворде, тот в цирке не смеется"

7

Re: Знак абзаца перед курсив и жирный

AlexStar пишет:

Если актуально и по делу, то задача решается созданием стилей и редактирование документа с применением созданных стилей (вложенный файл, как то так).

Спасибо.
Но это мне нужен для сайта. WYSIWYG редактор сайта не видят стиль. Он принимает только 2 Enter как <p> </p> и <p> </p>.

8

Re: Знак абзаца перед курсив и жирный

yuklov пишет:
AlexStar пишет:

Если актуально и по делу, то задача решается созданием стилей и редактирование документа с применением созданных стилей (вложенный файл, как то так).

Спасибо.
Но это мне нужен для сайта. WYSIWYG редактор сайта не видят стиль. Он принимает только 2 Enter как <p> </p> и <p> </p>.

У вас есть вариант в Ворде?

"Ты не умничай, ты пальцем покажи"
"Кто поработал с многоуровневым списком в Ворде, тот в цирке не смеется"

9

Re: Знак абзаца перед курсив и жирный

Так как уже нарисовал в меру своих познаний то:

Sub Test1()
M2FontSize = 11
Dim PRG As Paragraph

Application.ScreenUpdating = False

 ' чистим текст, убираем пустые параграфы, как вариант
For Each PRG In ActiveDocument.Paragraphs
PRG.Range.Select
If Len(PRG.Range.Text) = 1 Then
PRG.Range.Paragraphs(1).Range.Characters.First.Delete
End If
Next PRG

' расставляем пустые параграфы согласно задаче
For Each PRG In ActiveDocument.Paragraphs
PRG.Range.Select

' применимо к "подзаголовок" (жирненикий и размер = 11 и не пустой параграф)
If Selection.Font.Bold And Len(Selection.Text) > 1 And Selection.Font.size = M2FontSize Then
   Selection.Paragraphs.Add
End If


' применимо к обычному тексту (не жирный и не италик и не пустой параграф)
If Not Selection.Font.Bold And Not Selection.Font.Italic And Len(Selection.Text) > 1 Then
  Selection.Paragraphs.Add
' Selection.Paragraphs.Add  ' убрать знак коментария если нужно добавить второй пустой параграф
End If
  
' применимо к тексу италик
If Selection.Font.Italic And Len(Selection.Text) > 1 Then
  If Not Selection.Paragraphs(1).Range.Next.Font.Italic Then ' если следующий параграф.шрифт не италик то
  Selection.Paragraphs.Add
  End If
  End If
Next PRG
Application.ScreenUpdating = True
End Sub

"Алгоритм" основан на анализе шрифта и соответственно, что делать. Не проблема, что и где допилить, так как описание задачи надо еще понять.

"Ты не умничай, ты пальцем покажи"
"Кто поработал с многоуровневым списком в Ворде, тот в цирке не смеется"

10

Re: Знак абзаца перед курсив и жирный

AlexStar пишет:
yuklov пишет:
AlexStar пишет:

Если актуально и по делу, то задача решается созданием стилей и редактирование документа с применением созданных стилей (вложенный файл, как то так).

Спасибо.
Но это мне нужен для сайта. WYSIWYG редактор сайта не видят стиль. Он принимает только 2 Enter как <p> </p> и <p> </p>.

У вас есть вариант в Ворде?

Даб есть:

Post's attachments

Текст для пробы.docx 19.29 Кб, 1 скачиваний с 2018-01-10 

You don't have the permssions to download the attachments of this post.

11

Re: Знак абзаца перед курсив и жирный

AlexStar пишет:

Так как уже нарисовал в меру своих познаний то:

Sub Test1()
M2FontSize = 11
Dim PRG As Paragraph

Application.ScreenUpdating = False

 ' чистим текст, убираем пустые параграфы, как вариант
For Each PRG In ActiveDocument.Paragraphs
PRG.Range.Select
If Len(PRG.Range.Text) = 1 Then
PRG.Range.Paragraphs(1).Range.Characters.First.Delete
End If
Next PRG

' расставляем пустые параграфы согласно задаче
For Each PRG In ActiveDocument.Paragraphs
PRG.Range.Select

' применимо к "подзаголовок" (жирненикий и размер = 11 и не пустой параграф)
If Selection.Font.Bold And Len(Selection.Text) > 1 And Selection.Font.size = M2FontSize Then
   Selection.Paragraphs.Add
End If


' применимо к обычному тексту (не жирный и не италик и не пустой параграф)
If Not Selection.Font.Bold And Not Selection.Font.Italic And Len(Selection.Text) > 1 Then
  Selection.Paragraphs.Add
' Selection.Paragraphs.Add  ' убрать знак коментария если нужно добавить второй пустой параграф
End If
  
' применимо к тексу италик
If Selection.Font.Italic And Len(Selection.Text) > 1 Then
  If Not Selection.Paragraphs(1).Range.Next.Font.Italic Then ' если следующий параграф.шрифт не италик то
  Selection.Paragraphs.Add
  End If
  End If
Next PRG
Application.ScreenUpdating = True
End Sub

"Алгоритм" основан на анализе шрифта и соответственно, что делать. Не проблема, что и где допилить, так как описание задачи надо еще понять.

Спасибо!
Очень близко.
Но макрос не доработает: ошибка 91.
Перед подзаголовкам должен быть 2 энтер.

Post's attachments

макрос-ошибка.jpg 174.23 Кб, файл не был скачан. 

You don't have the permssions to download the attachments of this post.

12

Re: Знак абзаца перед курсив и жирный

Добавил:
Selection.Paragraphs.Add Range:=Selection.Paragraphs(1).Range
//Вставляет пустой параграф перед выделенным параграфом

On Error Resume Next

//Добавил, чтобы код не вываливался в ошибку в случае если последний параграф тоже курсив (italic)
Selection.Paragraphs(1).Range.Next.Font.Italic - тут имеется проблема если последний параграф имеет шрифт курсив, а этот  код пытается найти свойство следующего параграфа которого нет.


Sub Test1()
M2FontSize = 11
Dim PRG As Paragraph

Application.ScreenUpdating = False

 ' чистим текст, убираем пустые параграфы, как вариант
For Each PRG In ActiveDocument.Paragraphs
PRG.Range.Select
If Len(PRG.Range.Text) = 1 Then
PRG.Range.Paragraphs(1).Range.Characters.First.Delete
End If
Next PRG

' расставляем пустые параграфы согласно задаче
For Each PRG In ActiveDocument.Paragraphs
PRG.Range.Select

' применимо к "подзаголовок" (жирненикий и размер = 11 и не пустой параграф)
If Selection.Font.Bold And Len(Selection.Text) > 1 And Selection.Font.size = M2FontSize Then
Selection.Paragraphs.Add Range:=Selection.Paragraphs(1).Range  ' пустой параграф перед заголовком  
Selection.Paragraphs.Add  ' после
End If


' применимо к обычному тексту (не жирный и не италик и не пустой параграф)
If Not Selection.Font.Bold And Not Selection.Font.Italic And Len(Selection.Text) > 1 Then
  Selection.Paragraphs.Add
' Selection.Paragraphs.Add  ' убрать знак коментария если нужно добавить второй пустой параграф
End If
  
' применимо к тексу италик
If Selection.Font.Italic And Len(Selection.Text) > 1 Then
On Error Resume Next  
If Not Selection.Paragraphs(1).Range.Next.Font.Italic Then ' если следующий параграф.шрифт не италик то
  Selection.Paragraphs.Add
  End If
  End If
Next PRG
Application.ScreenUpdating = True
End Sub
"Ты не умничай, ты пальцем покажи"
"Кто поработал с многоуровневым списком в Ворде, тот в цирке не смеется"

13

Re: Знак абзаца перед курсив и жирный

AlexStar пишет:

Добавил:
Selection.Paragraphs.Add Range:=Selection.Paragraphs(1).Range
//Вставляет пустой параграф перед выделенным параграфом

On Error Resume Next

//Добавил, чтобы код не вываливался в ошибку в случае если последний параграф тоже курсив (italic)
Selection.Paragraphs(1).Range.Next.Font.Italic - тут имеется проблема если последний параграф имеет шрифт курсив, а этот  код пытается найти свойство следующего параграфа которого нет.


Sub Test1()
M2FontSize = 11
Dim PRG As Paragraph

Application.ScreenUpdating = False

 ' чистим текст, убираем пустые параграфы, как вариант
For Each PRG In ActiveDocument.Paragraphs
PRG.Range.Select
If Len(PRG.Range.Text) = 1 Then
PRG.Range.Paragraphs(1).Range.Characters.First.Delete
End If
Next PRG

' расставляем пустые параграфы согласно задаче
For Each PRG In ActiveDocument.Paragraphs
PRG.Range.Select

' применимо к "подзаголовок" (жирненикий и размер = 11 и не пустой параграф)
If Selection.Font.Bold And Len(Selection.Text) > 1 And Selection.Font.size = M2FontSize Then
Selection.Paragraphs.Add Range:=Selection.Paragraphs(1).Range  ' пустой параграф перед заголовком  
Selection.Paragraphs.Add  ' после
End If


' применимо к обычному тексту (не жирный и не италик и не пустой параграф)
If Not Selection.Font.Bold And Not Selection.Font.Italic And Len(Selection.Text) > 1 Then
  Selection.Paragraphs.Add
' Selection.Paragraphs.Add  ' убрать знак коментария если нужно добавить второй пустой параграф
End If
  
' применимо к тексу италик
If Selection.Font.Italic And Len(Selection.Text) > 1 Then
On Error Resume Next  
If Not Selection.Paragraphs(1).Range.Next.Font.Italic Then ' если следующий параграф.шрифт не италик то
  Selection.Paragraphs.Add
  End If
  End If
Next PRG
Application.ScreenUpdating = True
End Sub


Спасибо большое!
Решать надо только одну проблему.
Макрос добавляет пустой абзац на все обычные абзацы.

Post's attachments

pustiye-abzatsi.jpg 103.25 Кб, файл не был скачан. 

You don't have the permssions to download the attachments of this post.

14

Re: Знак абзаца перед курсив и жирный

AlexStar пишет:

Добавил:
Selection.Paragraphs.Add Range:=Selection.Paragraphs(1).Range
//Вставляет пустой параграф перед выделенным параграфом

On Error Resume Next

//Добавил, чтобы код не вываливался в ошибку в случае если последний параграф тоже курсив (italic)
Selection.Paragraphs(1).Range.Next.Font.Italic - тут имеется проблема если последний параграф имеет шрифт курсив, а этот  код пытается найти свойство следующего параграфа которого нет.


Sub Test1()
M2FontSize = 11
Dim PRG As Paragraph

Application.ScreenUpdating = False

 ' чистим текст, убираем пустые параграфы, как вариант
For Each PRG In ActiveDocument.Paragraphs
PRG.Range.Select
If Len(PRG.Range.Text) = 1 Then
PRG.Range.Paragraphs(1).Range.Characters.First.Delete
End If
Next PRG

' расставляем пустые параграфы согласно задаче
For Each PRG In ActiveDocument.Paragraphs
PRG.Range.Select

' применимо к "подзаголовок" (жирненикий и размер = 11 и не пустой параграф)
If Selection.Font.Bold And Len(Selection.Text) > 1 And Selection.Font.size = M2FontSize Then
Selection.Paragraphs.Add Range:=Selection.Paragraphs(1).Range  ' пустой параграф перед заголовком  
Selection.Paragraphs.Add  ' после
End If


' применимо к обычному тексту (не жирный и не италик и не пустой параграф)
If Not Selection.Font.Bold And Not Selection.Font.Italic And Len(Selection.Text) > 1 Then
  Selection.Paragraphs.Add
' Selection.Paragraphs.Add  ' убрать знак коментария если нужно добавить второй пустой параграф
End If
  
' применимо к тексу италик
If Selection.Font.Italic And Len(Selection.Text) > 1 Then
On Error Resume Next  
If Not Selection.Paragraphs(1).Range.Next.Font.Italic Then ' если следующий параграф.шрифт не италик то
  Selection.Paragraphs.Add
  End If
  End If
Next PRG
Application.ScreenUpdating = True
End Sub


Спасибо большое!
Решать надо только одну проблему.
Макрос добавляет пустой абзац на все обычные абзацы. И перед заголовкам должны быть 2 пустого абзаца. А после заголовки 1 абзац.

15

Re: Знак абзаца перед курсив и жирный

AlexStar вы этот макрос писали вручную или записали макрос как на MS Word?
Просто при записи макроса Ворда такой код не получается. Или можно записать с таком кодом?

16

Re: Знак абзаца перед курсив и жирный

yuklov пишет:

AlexStar вы этот макрос писали вручную или записали макрос как на MS Word?
Просто при записи макроса Ворда такой код не получается. Или можно записать с таком кодом?

Макрос написан вручную. Макрорекордер записывает много лишнего. Если у вас что-то не срабатывает - нужно делать отлов ошибок (смотреть какая ошибка и на какой строке).

Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871

17

Re: Знак абзаца перед курсив и жирный

Sub Test2()
myText = "Автор," & Chr(13)
Dim PRG As Paragraph

Application.ScreenUpdating = False
For Each PRG In ActiveDocument.Paragraphs
PRG.Range.Select
If Len(PRG.Range.Text) = 1 Then
PRG.Range.Paragraphs(1).Range.Characters.First.Delete
End If
Next PRG

For Each PRG In ActiveDocument.Paragraphs
PRG.Range.Select

If Selection.Font.Bold And Len(Selection.Text) > 1 And Selection.Range.Text <> myText Then
   Selection.Paragraphs.Add Range:=Selection.Paragraphs(1).Range
   Selection.Paragraphs.Add
End If

If Not Selection.Font.Bold And Not Selection.Font.Italic And Len(Selection.Text) > 1 Then
  Selection.Paragraphs.Add
End If
  
 
If Selection.Font.Italic And Len(Selection.Text) > 1 Then
On Error GoTo Ends
  If Not Selection.Paragraphs(1).Range.Next.Font.Italic Then
    Selection.Paragraphs.Add
Ends:
  End If
  End If
Next PRG
Application.ScreenUpdating = True
End Sub

 

Удачи.

"Ты не умничай, ты пальцем покажи"
"Кто поработал с многоуровневым списком в Ворде, тот в цирке не смеется"