1

Тема: как заставить макрос выполняться много раз?

макрос простенький: найти дефис, 4 раза влево, ентер. Проще говоря, текст за 4 символа левее дефиса, перенести в следующую строку. Но это надо сделать в каждой строке, а их много. Как заставить макрос выполняться снова и снова до конца текста? Повторно с начала текста - не надо. Спасибо.

2

Re: как заставить макрос выполняться много раз?

Вариант, проверил, работает.  В Str присвойте нужный символ или расширьте запрос через форму. 

Sub TestDash()             '(str As String)
Dim SerchText As Range
Dim ChPrg As Integer
Dim Str As String
Dim Prg As Paragraph


Str = "-"
Set SerchText = ActiveDocument.Range

SerchText.Find.ClearFormatting
    With SerchText.Find
         .Text = Str
         .Forward = True
         .Wrap = wdFindStop
         .MatchWildcards = False
    End With
    SerchText.Find.Execute
    
    While SerchText.Find.Found = True
          SerchText.Select
          
          Set Prg = Selection.Paragraphs(1)
          ChPrg = Len(Prg.Range.Text)
                    
          If Selection.Start = Selection.Paragraphs.First.Range.Start Then   'если позиция выделения = позиции выделения начала параграфа
             
             If ChPrg > 5 Then
                Selection.MoveRight Unit:=wdCharacter, Count:=5
                Selection.TypeParagraph
             End If
           End If
           SerchText.Find.Execute
    Wend           
End Sub
"Ты не умничай, ты пальцем покажи"
"Кто поработал с многоуровневым списком в Ворде, тот в цирке не смеется"

3

Re: как заставить макрос выполняться много раз?

Попутал: налево или направо
При условии, что в абзаце только один знак дефиса, код работает. Проверка позиции знака дефиса необходима для исключения установки знака перевода строки с предыдущего абзаца. В случае если в абзаце находятся более двух знаков абзаца, будет найдена позиция первого вхождения.

Sub TestDash() 
Dim SerchText As Range
Dim PrgTxt As String
Dim Str As String
Dim Prg As Paragraph

Str = "-"
Set SerchText = ActiveDocument.Range

SerchText.Find.ClearFormatting
    With SerchText.Find
         .Text = Str
         .Forward = True
         .Wrap = wdFindStop ' wdFindContinue
         .MatchWildcards = False
    End With
    SerchText.Find.Execute
    
    While SerchText.Find.Found = True
          SerchText.Select
          
          Set Prg = Selection.Paragraphs(1)
          PrgTxt = Prg.Range.Text
          
             If 5 < InStr(1, PrgTxt, Str) Then
                Selection.MoveLeft Unit:=wdCharacter, Count:=5
                Selection.TypeParagraph
             End If
           SerchText.Find.Execute
    Wend
            
End Sub
"Ты не умничай, ты пальцем покажи"
"Кто поработал с многоуровневым списком в Ворде, тот в цирке не смеется"

4

Re: как заставить макрос выполняться много раз?

спасибо, помогло.
Несколько дефисов если в строке - да, проблема, буду как-то выкручиваться

5

Re: как заставить макрос выполняться много раз?

Так будет работать всегда но в случае если файл будет содержать менее 5 символов и с дефисом то в результате вывалится.  Изучите перехват исключительных ситуаций, защитите код.


Sub TestDash() 
Dim SerchText As Range
Dim Str As String


Str = "-"
Set SerchText = ActiveDocument.Range

SerchText.Find.ClearFormatting
    With SerchText.Find
         .Text = Str
         .Forward = True
         .Wrap = wdFindStop ' wdFindContinue
         .MatchWildcards = False
    End With
    SerchText.Find.Execute
    
    While SerchText.Find.Found = True
          SerchText.Select
          Selection.MoveLeft Unit:=wdCharacter, Count:=5
           Selection.TypeParagraph
           SerchText.Find.Execute
    Wend
            
End Sub
"Ты не умничай, ты пальцем покажи"
"Кто поработал с многоуровневым списком в Ворде, тот в цирке не смеется"

6

Re: как заставить макрос выполняться много раз?

AlexStar пишет:

Так будет работать всегда но в случае если файл будет содержать менее 5 символов и с дефисом то в результате вывалится.  Изучите перехват исключительных ситуаций, защитите код.


Sub TestDash() 
Dim SerchText As Range
Dim Str As String


Str = "-"
Set SerchText = ActiveDocument.Range

SerchText.Find.ClearFormatting
    With SerchText.Find
         .Text = Str
         .Forward = True
         .Wrap = wdFindStop ' wdFindContinue
         .MatchWildcards = False
    End With
    SerchText.Find.Execute
    
    While SerchText.Find.Found = True
          SerchText.Select
          Selection.MoveLeft Unit:=wdCharacter, Count:=5
           Selection.TypeParagraph
           SerchText.Find.Execute
    Wend
            
End Sub

Ну так проверку Len() сделать

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