Makrokomandos poveikio pavyzdys

Kaip „keitimų sekimo“ žymes Word dokumente paversti paprastai formatuotu „lyginamuoju variantu“ – su makrokomanda

Prieš keletą metų tinklaraštyje publikavau įrašą apie tai, kaip Microsoft Word dokumentą su įjungtu keitimų paversti teisingu dokumento „lyginamuoju variantu“ – tokiu, kokie daromi rengiant teisės aktų pakeitimus. Mano aprašytas kelias buvo sąlyginai sudėtingas – Word dokumentą reikėjo įrašyti kaip HTML failą, tada atlikti jame paiešką ir keitimus, tada dokumentą vėl atverti su Word, ir galiausiai tekdavo kažkiek taisyti formatavimą. Paprasčiau, nei ilgame dokumente skrupulingai įrašinėti tekstą, jį ryškinti ir braukyti, bet visgi.

Bet štai neseniai radau būdą, kaip Word arba LibreOffice makrokomandos pagalba tai galima padaryti keliais pelės spragtelėjimais, neužsiimant visom sudėtingom manipuliacijom.

Word atveju, tereikia įsirašyti Word makrokomandą – štai šią:

Plain text
Copy to clipboard
Open code in new window
EnlighterJS 3 Syntax Highlighter
Sub TrackChangesToFormatting()
Dim chgAdd As Word.Revision
' informuojame vartotoją, jei dokumentas be susektų pakeitimų
If ActiveDocument.Revisions.Count = 0 Then
MsgBox "Šiame dokumente nėra užfiksuotų pakeitimų", vbOKOnly + vbInformation
Else
ActiveDocument.TrackRevisions = False
' ciklas visų pakeitimų peržiūrai
For Each chgAdd In ActiveDocument.Revisions
' keičiam susektus išbraukimus į paprastą išbrauktą tekstą
If chgAdd.Type = wdRevisionDelete Then
chgAdd.Range.Font.StrikeThrough = True
chgAdd.Reject
' perspėjam vartotoją, jei aptiktas teksto perkėlimas;
' tokius makrokomanda palieka nepakeistus, tik pažymi
ElseIf chgAdd.Type = wdRevisionMovedFrom Then
MsgBox ("Makrokomanda nepalaiko teksto perkėlimų (tik trynimą/įterpimą)."), vbOKOnly + vbExclamation
chgAdd.Range.Select ' move insertion point
ElseIf chgAdd.Type = wdRevisionMovedTo Then
MsgBox ("Makrokomanda nepalaiko teksto perkėlimų (tik trynimą/įterpimą)."), vbOKOnly + vbExclamation
chgAdd.Range.Select ' move insertion point
' keičiam susektus įterpimus į paryškintą tekstą
ElseIf chgAdd.Type = wdRevisionInsert Then
chgAdd.Range.Font.Bold = True
chgAdd.Accept
' bet kokius kitokius pakeitimus pažymime žaliai ir perspėjame vartotoją
Else
MsgBox ("Rastas kitoks teksto pakeitimas: jis priimtas ir pažymėtas žalsvai."), vbOKOnly + vbExclamation
chgAdd.Range.HighlightColorIndex = wdBrightGreen
chgAdd.Accept
' chgAdd.Range.Select ' move insertion point
End If
Next chgAdd
End If
'
' makrokomandos dalis pažymėti tekstui, kuris yra ir paryškintas, ir išbrauktas;
' taip nutinka, kai dokumentas buvo taisomas dviejų skirtingų autorių, kurių vienas įrašo pakeitimus,
' o kitas juos ar dalį jų panaikina
'
MsgBox ("Jei bus rasta konfliktuojančių dviejų autorių keitimų, jie bus pažymėti žydrai"), vbOKOnly + vbInformation
Options.DefaultHighlightColorIndex = wdTurquoise
Selection.Find.ClearFormatting
With Selection.Find.Font
.Bold = True
.StrikeThrough = True
.DoubleStrikeThrough = False
End With
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Highlight = wdPink ' iš teisų veikia aukščiau esanti Option... parinktis spalvai parinkti
With Selection.Find
.Text = ""
.Replacement.Text = "^&"
.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
Sub TrackChangesToFormatting() Dim chgAdd As Word.Revision ' informuojame vartotoją, jei dokumentas be susektų pakeitimų If ActiveDocument.Revisions.Count = 0 Then MsgBox "Šiame dokumente nėra užfiksuotų pakeitimų", vbOKOnly + vbInformation Else ActiveDocument.TrackRevisions = False ' ciklas visų pakeitimų peržiūrai For Each chgAdd In ActiveDocument.Revisions ' keičiam susektus išbraukimus į paprastą išbrauktą tekstą If chgAdd.Type = wdRevisionDelete Then chgAdd.Range.Font.StrikeThrough = True chgAdd.Reject ' perspėjam vartotoją, jei aptiktas teksto perkėlimas; ' tokius makrokomanda palieka nepakeistus, tik pažymi ElseIf chgAdd.Type = wdRevisionMovedFrom Then MsgBox ("Makrokomanda nepalaiko teksto perkėlimų (tik trynimą/įterpimą)."), vbOKOnly + vbExclamation chgAdd.Range.Select ' move insertion point ElseIf chgAdd.Type = wdRevisionMovedTo Then MsgBox ("Makrokomanda nepalaiko teksto perkėlimų (tik trynimą/įterpimą)."), vbOKOnly + vbExclamation chgAdd.Range.Select ' move insertion point ' keičiam susektus įterpimus į paryškintą tekstą ElseIf chgAdd.Type = wdRevisionInsert Then chgAdd.Range.Font.Bold = True chgAdd.Accept ' bet kokius kitokius pakeitimus pažymime žaliai ir perspėjame vartotoją Else MsgBox ("Rastas kitoks teksto pakeitimas: jis priimtas ir pažymėtas žalsvai."), vbOKOnly + vbExclamation chgAdd.Range.HighlightColorIndex = wdBrightGreen chgAdd.Accept ' chgAdd.Range.Select ' move insertion point End If Next chgAdd End If ' ' makrokomandos dalis pažymėti tekstui, kuris yra ir paryškintas, ir išbrauktas; ' taip nutinka, kai dokumentas buvo taisomas dviejų skirtingų autorių, kurių vienas įrašo pakeitimus, ' o kitas juos ar dalį jų panaikina ' MsgBox ("Jei bus rasta konfliktuojančių dviejų autorių keitimų, jie bus pažymėti žydrai"), vbOKOnly + vbInformation Options.DefaultHighlightColorIndex = wdTurquoise Selection.Find.ClearFormatting With Selection.Find.Font .Bold = True .StrikeThrough = True .DoubleStrikeThrough = False End With Selection.Find.Replacement.ClearFormatting Selection.Find.Replacement.Highlight = wdPink ' iš teisų veikia aukščiau esanti Option... parinktis spalvai parinkti With Selection.Find .Text = "" .Replacement.Text = "^&" .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
Sub TrackChangesToFormatting()
Dim chgAdd As Word.Revision
' informuojame vartotoją, jei dokumentas be susektų pakeitimų
If ActiveDocument.Revisions.Count = 0 Then
    MsgBox "Šiame dokumente nėra užfiksuotų pakeitimų", vbOKOnly + vbInformation
Else
    ActiveDocument.TrackRevisions = False
    ' ciklas visų pakeitimų peržiūrai
    For Each chgAdd In ActiveDocument.Revisions
        ' keičiam susektus išbraukimus į paprastą išbrauktą tekstą
        If chgAdd.Type = wdRevisionDelete Then
            chgAdd.Range.Font.StrikeThrough = True
            chgAdd.Reject
        ' perspėjam vartotoją, jei aptiktas teksto perkėlimas;
        ' tokius makrokomanda palieka nepakeistus, tik pažymi
        ElseIf chgAdd.Type = wdRevisionMovedFrom Then
            MsgBox ("Makrokomanda nepalaiko teksto perkėlimų (tik trynimą/įterpimą)."), vbOKOnly + vbExclamation
            chgAdd.Range.Select ' move insertion point
        ElseIf chgAdd.Type = wdRevisionMovedTo Then
            MsgBox ("Makrokomanda nepalaiko teksto perkėlimų (tik trynimą/įterpimą)."), vbOKOnly + vbExclamation
            chgAdd.Range.Select ' move insertion point
        ' keičiam susektus įterpimus į paryškintą tekstą
        ElseIf chgAdd.Type = wdRevisionInsert Then
            chgAdd.Range.Font.Bold = True
            chgAdd.Accept
        ' bet kokius kitokius pakeitimus pažymime žaliai ir perspėjame vartotoją
        Else
            MsgBox ("Rastas kitoks teksto pakeitimas: jis priimtas ir pažymėtas žalsvai."), vbOKOnly + vbExclamation
            chgAdd.Range.HighlightColorIndex = wdBrightGreen
            chgAdd.Accept
            ' chgAdd.Range.Select ' move insertion point
        End If
    Next chgAdd
End If

'
' makrokomandos dalis pažymėti tekstui, kuris yra ir paryškintas, ir išbrauktas;
' taip nutinka, kai dokumentas buvo taisomas dviejų skirtingų autorių, kurių vienas įrašo pakeitimus,
' o kitas juos ar dalį jų panaikina
'
MsgBox ("Jei bus rasta konfliktuojančių dviejų autorių keitimų, jie bus pažymėti žydrai"), vbOKOnly + vbInformation
    Options.DefaultHighlightColorIndex = wdTurquoise
    Selection.Find.ClearFormatting
    With Selection.Find.Font
        .Bold = True
        .StrikeThrough = True
        .DoubleStrikeThrough = False
    End With
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Highlight = wdPink ' iš teisų veikia aukščiau esanti Option... parinktis spalvai parinkti
    With Selection.Find
        .Text = ""
        .Replacement.Text = "^&"
        .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

Kur šią makrokomandą dėti? Makrokomandų kūrimas detaliai paaiškintas Microsoft Word pagalbos puslapyje „Makrokomandos kūrimas arba vykdymas“. Jei trumpai, Mano naudojamoje Word 2013 versijoje reikia atverti paskutinę kortelę „Programų kūrėjas“, spausti mygtuką „Makrokomanda“, atsidariusiame dialoge įrašyti makrokomandos pavadinimą „TrackChangesToFormatting“ ir spausti mygtuką „Kurti“.

Atsivėrus Microsoft Visual Basic rengyklei įterpti makrokomandos tekstą:

„Keitimų sekimo“ žymų pakeitimas paprastu formatavimu - makrokomandos įrašymo langas
„Keitimų sekimo“ žymų pakeitimas paprastu formatavimu – makrokomandos įrašymo langas

Tada įrašome pakeitimus ir užveriame Visual Basic langą. Makrokomandą galima matyti štai čia:

„Keitimų sekimo“ žymų pakeitimas paprastu formatavimu - makrokomandų dialogas
„Keitimų sekimo“ žymų pakeitimas paprastu formatavimu – makrokomandų dialogas

Įvykdyti makrokomandą galima paspaudus mygtuką „Vykdyti“.

Rezultatas – tekstas, kuriame keitimai pakeisti formatuotu (įterpimai paryškinti, išbraukimai – perbraukti) tekstu.

Žinoma, galima sukurti specialų mygtuką šiai makrokomandai Microsoft Word lange.

Šios makrokomandos kūrimui panaudojau stackexchange diskusijoje pateiktą pavyzdį.

O štai analogiška makrokomanda LibreOffice programai:

Plain text
Copy to clipboard
Open code in new window
EnlighterJS 3 Syntax Highlighter
Sub TrackChangesToFormatting
'based on: https://www.literatureandlatte.com/web/forum/viewtopic.php?t=37746
dim doc as object
dim viewCursor as object
dim redLines as object
dim redLine as object
dim document as object
dim dispatcher as object
dim count as long
dim args2(0) as new com.sun.star.beans.PropertyValue
dim args4(2) as new com.sun.star.beans.PropertyValue
args2(0).Name = "Strikeout.Kind"
args2(0).Value = 1
doc = ThisComponent
viewCursor = doc.CurrentController.ViewCursor
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
redLines = doc.Redlines
count = redLines.getCount() - 1
for i = 0 to count
redLine = redLines.getByIndex(0) 'does not work with getByIndex(i)
viewCursor.gotoRange(redLine.RedlineStart, false)
viewCursor.gotoRange(redLine.RedlineEnd, true)
if redLine.RedlineType = "Delete" Then
dispatcher.executeDispatch(document, ".uno:Strikeout", "", 0, args2())
dispatcher.executeDispatch(document, ".uno:RejectTrackedChange", "", 0, Array())
elseif redLine.RedlineType = "Insert" Then
dispatcher.executeDispatch(document, ".uno:Bold", "", 0, args4())
dispatcher.executeDispatch(document, ".uno:AcceptTrackedChange", "", 0, Array())
elseif redLine.RedlineType = "Format" Then
dispatcher.executeDispatch(document, ".uno:AcceptTrackedChange", "", 0, Array())
end if
next i
End Sub
Sub TrackChangesToFormatting 'based on: https://www.literatureandlatte.com/web/forum/viewtopic.php?t=37746 dim doc as object dim viewCursor as object dim redLines as object dim redLine as object dim document as object dim dispatcher as object dim count as long dim args2(0) as new com.sun.star.beans.PropertyValue dim args4(2) as new com.sun.star.beans.PropertyValue args2(0).Name = "Strikeout.Kind" args2(0).Value = 1 doc = ThisComponent viewCursor = doc.CurrentController.ViewCursor document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") redLines = doc.Redlines count = redLines.getCount() - 1 for i = 0 to count redLine = redLines.getByIndex(0) 'does not work with getByIndex(i) viewCursor.gotoRange(redLine.RedlineStart, false) viewCursor.gotoRange(redLine.RedlineEnd, true) if redLine.RedlineType = "Delete" Then dispatcher.executeDispatch(document, ".uno:Strikeout", "", 0, args2()) dispatcher.executeDispatch(document, ".uno:RejectTrackedChange", "", 0, Array()) elseif redLine.RedlineType = "Insert" Then dispatcher.executeDispatch(document, ".uno:Bold", "", 0, args4()) dispatcher.executeDispatch(document, ".uno:AcceptTrackedChange", "", 0, Array()) elseif redLine.RedlineType = "Format" Then dispatcher.executeDispatch(document, ".uno:AcceptTrackedChange", "", 0, Array()) end if next i End Sub
Sub TrackChangesToFormatting
'based on: https://www.literatureandlatte.com/web/forum/viewtopic.php?t=37746
   dim doc as object
   dim viewCursor as object
   dim redLines as object
   dim redLine as object
   dim document as object
   dim dispatcher as object
   dim count as long
   dim args2(0) as new com.sun.star.beans.PropertyValue
   dim args4(2) as new com.sun.star.beans.PropertyValue

   args2(0).Name = "Strikeout.Kind"
   args2(0).Value = 1

   doc = ThisComponent
   viewCursor = doc.CurrentController.ViewCursor

   document   = ThisComponent.CurrentController.Frame
   dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

   redLines = doc.Redlines
   count = redLines.getCount() - 1
   for i = 0 to count
      redLine = redLines.getByIndex(0) 'does not work with getByIndex(i)
      viewCursor.gotoRange(redLine.RedlineStart, false)
      viewCursor.gotoRange(redLine.RedlineEnd, true)
      if redLine.RedlineType = "Delete" Then
         dispatcher.executeDispatch(document, ".uno:Strikeout", "", 0, args2())
         dispatcher.executeDispatch(document, ".uno:RejectTrackedChange", "", 0, Array())
      elseif redLine.RedlineType = "Insert" Then
         dispatcher.executeDispatch(document, ".uno:Bold", "", 0, args4())
         dispatcher.executeDispatch(document, ".uno:AcceptTrackedChange", "", 0, Array())
      elseif redLine.RedlineType = "Format" Then
         dispatcher.executeDispatch(document, ".uno:AcceptTrackedChange", "", 0, Array())
      end if
   next i
End Sub

Šios makrokomandos kūrimui panaudojau šiame puslapyje pateiktą pavyzdį.


Paskelbta

sukūrė

Komentarai

Parašykite komentarą

El. pašto adresas nebus skelbiamas. Būtini laukeliai pažymėti *

This site uses Akismet to reduce spam. Learn how your comment data is processed.

Raktažodžiai

atviras kodas bylos Codeigniter darbas drėlingas el. parašas EŽTT genocidas gimimas holokaustas InEnglish internetas joga Jurgelis karo nusikaltimai kde konferencija Kononov Kraujelis kubuntu LAT LGGRTC lietuvybė linux microsoft mokslai mokslas nusikaltimai žmoniškumui partizanai PHP pokaris programavimas programos religija religijos laisvė sausio13 sektos seneliai teismas teisė tinklaraštis vasiliauskas vertimas wordpress žurnalizmas

Vėliausi įrašai

Mano web projektai

Sąskaitos paprastai | Patobulinta juridinių asmenų paieška | Asmens kodų tikrinimo priemonė

Hobiai

Happysup.eu | Pawed Wave

Visuomenė, politika, etc.

Gentys | Religija.lt | Lietuvos religijotyrininkų draugija | Krizių įveikimo centras | GPB | BDS judėjimas

Tinklaraščiai

Kūlverstukas | Rimas Kudelis | Ar kas nors dar rašo tinklaraščius? 🙂

Technologijos

Codeigniter | HTMX | Alpine.js | Kubuntu

Mano viešasis PGP raktas
keybase.io paskyra

Autorinės teisės

© 2004-2024, Donatas Glodenis. Šiame tinklaraštyje paskelbtą autorinį turinį kitur galima naudoti tik gavus raštišką autoriaus sutikimą.

Jei konkrečiu atveju nėra nurodyta kitaip, tinklaraščio įrašuose išsakomi vertinimai yra asmeninė jų autoriaus nuomonė.