Kan en Word-kyndig hjelpe meg med å få til en makro som flytte ned alle linjer som begynner med et nøkkelord to linjer ned?

[Pallantir]

Utgangsteksten i noen dokumenter jeg bruker, ser ut som dette:

 

nøkkelord 3
Det var en gange en nisse
som måtte tisse

Han hoppet over et gjerde,
der fant han ei pære

nøkkelord 2
den delte han i fem,
én, to, tre, fire, fem

 

Så teksten på de to linjene under forandrer seg, og tallet etter "nøkkelord" forandrer seg også, og det er ikke alle grupper av to linjer som har "nøkkelord" over seg. Det jeg er ute etter er en makro for Word (jeg bruker 2007 fordi firmaet jeg jobber for er for gjerrige til å oppdatere, og den gjør jo egentlig også alt vi trenger) som kan flytte ned linja med "nøkkelord" to hakk, så det blir sånn:

 

Det var en gange en nisse
som måtte tisse
nøkkelord 3

Han hoppet over et gjerde,
der fant han ei pære

den delte han i fem,
én, to, tre, fire, fem
nøkkelord 2

Det vil alltid være to linjer under "nøkkelord", så den skal alltid flyttes to linjer ned. Jeg fant en seks år gammel makro på nettet som gjorde nesten det jeg ville:

 

Sub Flyttonedlinje()

    Application.ScreenUpdating = False

    Selection.HomeKey Unit:=wdLine
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    Selection.Cut
    Selection.TypeText Text:="µµµµ"
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "nøkkelord"
        .Replacement.Text = ""
        .Forward = True
    End With
    Selection.Find.Execute
    
    Selection.HomeKey Unit:=wdLine
    Selection.MoveUp Unit:=wdLine, Count:=1
    Selection.Paste
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "µµµµ"
        .Replacement.Text = ""
        .Forward = True
    End With
    Selection.Find.Execute
    
    Selection.Delete Unit:=wdCharacter, Count:=1
End Sub

Den gjør det kanskje ikke på noen elegant måte, med bruken av innsetting av µµµµ, men den fungerer. Problemet er at den bare fungerer på den første gangen den ser "nøkkelord". Jeg trenger at den skal søke igjennom hele dokumentet (som kan være på en god del sider) og gjør det samme på alle stedene der det står "nøkkelord".

Endret 11. november 2023 av Pallantir

[Locrin]

Sub MoveLineTwoLinesDown()
    Dim keyword As String
    keyword = "keyword" ' Change "keyword" to the actual keyword you want to search for
    
    Dim line As Range
    Dim document As Document
    Set document = ActiveDocument
    
    For Each line In document.Paragraphs
        If InStr(line, keyword) > 0 Then
            line.Range.Cut
            line.Range.InsertAfter vbCr & vbCr
            document.Undo ' Preserve the position of the keyword
            Exit For
        End If
    Next line
End Sub

Chatgpt foreslår dette.

[Pallantir]

Takk for forsøket, men jeg har alt fått et svar i PM med en fungerende utgave som er innlemmet. Jeg glemte å legge det ut. Beklager.