oParEnum = ThisComponent.Text.createEnumeration()
Do While oParEnum.hasMoreElements()
oPar = oParEnum.nextElement()
If oPar.supportsService("com.sun.star.text.Paragraph") Then
nPars = nPars + 1
oSecEnum = oPar.createEnumeration()
Do While oSecEnum.hasMoreElements()
oParSection = oSecEnum.nextElement()
msgbox oParSection.TextPortionType & " " & oparsection.string
Loop
End If
Loop
sub test()
' markRedline
'reject the deleted changes before the next step
'restoreDeleted
end sub
Sub MarkRedline
dim redline as boolean
oParEnum = ThisComponent.Text.createEnumeration()
Do While oParEnum.hasMoreElements()
oPar = oParEnum.nextElement()
If oPar.supportsService("com.sun.star.text.Paragraph") Then
nPars = nPars + 1
oSecEnum = oPar.createEnumeration()
Do While oSecEnum.hasMoreElements()
oParSection = oSecEnum.nextElement()
if oParSection.TextPortionType = "Redline" then redline = not redline
if oParSection.TextPortionType = "Text" then
if redline = true then
oParSection.charstylename = "Deleted"
end if
end if
Loop
End If
Loop
end sub
Sub restoreDeleted
oParEnum = ThisComponent.Text.createEnumeration()
Do While oParEnum.hasMoreElements()
oPar = oParEnum.nextElement()
dim redline as boolean
If oPar.supportsService("com.sun.star.text.Paragraph") Then
nPars = nPars + 1
oSecEnum = oPar.createEnumeration()
Do While oSecEnum.hasMoreElements()
oParSection = oSecEnum.nextElement()
if oParSection.TextPortionType = "Text" then
if oParSection.charstylename = "Deleted" then oParsection.string =""
end if
Loop
End If
Loop
end sub
emanuele.gissi wrote:I did not find any guidance on how to merge odt files by a script.
Can you point me to something about that?
Edit: I have now tested it. The AutoSaved temporary file only contains the link to the sub document - it contains no text from the sub document. |
This is why I would like to show all the corrections in the odm.
oParEnum = ThisComponent.Text.createEnumeration()
Do While oParEnum.hasMoreElements()
oPar = oParEnum.nextElement()
If oPar.supportsService("com.sun.star.text.Paragraph") Then
nPars = nPars + 1
oSecEnum = oPar.createEnumeration()
Do While oSecEnum.hasMoreElements()
oParSection = oSecEnum.nextElement()
if oParSection.TextPortionType = "Redline" then
msgbox oParSection.RedlineType
end if
Loop
End If
Loop
Sub MarkRedline
dim redline as boolean
oParEnum = ThisComponent.Text.createEnumeration()
Do While oParEnum.hasMoreElements()
oPar = oParEnum.nextElement()
If oPar.supportsService("com.sun.star.text.Paragraph") Then
nPars = nPars + 1
oSecEnum = oPar.createEnumeration()
Do While oSecEnum.hasMoreElements()
oParSection = oSecEnum.nextElement()
if oParSection.TextPortionType = "Redline" then
redline = not redline
redlinetype = oParSection.redlinetype
end if
if oParSection.TextPortionType = "Text" then
if redline = true then
select case redlinetype
case "Delete"
oParSection.charstylename = "Deleted"
case "Insert"
oParSection.charstylename = "Inserted"
end select
end if
redlinetype =""
end if
Loop
End If
Loop
end sub
emanuele.gissi wrote:I did not find any source explaining ho to merge the content.xml. And I have to import all external contents (eg. images) as well.
I presume a lot of renumbering of element ids is required to avoid clashes.
emanuele.gissi wrote:The result is surprisingly good. I am quite satisfied. I think this approach solves my problem in a brilliant way!
'to do
'- exit if no selection
'-restore selection state, changes states
'full selection if table start
Option Explicit
private type RedlineType 'my custom type
RedlineAuthor as string 'the name of the author of the change.
RedlineDateTime as com.sun.star.util.DateTime 'date and time of the change.
RedlineComment as string ' comment for the change.
RedlineType as string 'Insert, Delete, Format , TextTable, Style
'RedlineSuccessorData 'com.sun.star.beans.PropertyValues RedlineSuccessorData; second level redline data The elements of the sequence are string RedlineAuthor; com::sun::star::util::DateTime RedlineDateTime; string RedlineComment; string RedlineType;
RedlineIdentifier as string 'contains a unique identifier for the redline. This is necessary for file export filters to able to recognize redline portions that point to the same redline.
IsInHeaderFooter as boolean 'boolean IsInHeaderFooter; determines whether the portion is member of a header or footer text.
'RedlineText XText RedlineText;the text of the redline. Only provided if the change is not visible. The visibility depends on the redline display options that are set at the documents property set (RedlineDisplayType).
MergeLastPara as boolean 'whether the last paragraph of a redline text has to be merged with a possible following text content (i.e. a text table)
CharOverline as long
CharColor as long
redlinestart as NEW com.sun.star.text.textrange
redlineend as NEW com.sun.star.text.textrange
cstring as string
end type
Global Redlines(),ubredlines as long, trans ,hasRedlines as boolean
Global DeleteCharColor as long,InsertCharColor as long,FormatCharColor as long,ColorsSet as boolean
sub testsub()
dim Doc,NewDoc
Doc = thisComponent
CopyWithRedlines(doc)
NewDoc = StarDesktop.loadComponentFromURL("private:factory/swriter","_blank",0,Array())
PasteWithRedlines NewDoc
end sub
sub CopyWithRedlines(doc)
setWinPointer Doc,2 'WAIT
' oVC = thisComponent.getCurrentController.getViewCursor
' TC = oVC.getText.createTextCursorByRange(oVC)
On Error goto hr
Doc.lockControllers
with doc
hasRedlines=.getredlines.haselements
if hasRedlines =false then
trans = .currentcontroller.gettransferable
else
UBREDLINES = -1
if ColorsSet = false then
DeleteCharColor = rgb(50,50,50)
InsertCharColor = rgb(100,100,100)
FormatCharColor = rgb(150,150,150)
ColorsSet = true
end if
.UndoManager.enterUndoContext "Copy"
.RedlineDisplayType =2 'inserted and removed
.RecordChanges = false
getallRedlines Doc
trans = .currentcontroller.gettransferable
'thiscomponent.RedlineDisplayType =0 'inserted and removed
with doc.UndoManager
.leaveUndoContext
.undo
.clearRedo
end with
end if
end with ' doc.currentcontroller.select(TC)
setWinPointer Doc,3 'Text
hr:
Doc.unlockControllers
end sub
Sub GetallRedlines(doc)
dim ORedlines,i,RedlineEnum, oRedline, RedlineType as string,RCell, TC
if doc.getredlines.haselements =false then exit sub '
' TC = doc.gettext.createtextcursor
oRedlines = doc.getredlines
ubredlines = oRedlines.count-1
redim redlines(ubredlines)
RedlineEnum = oRedlines.createEnumeration()
Do While RedlineEnum.hasMoreElements()
oRedline = RedlineEnum.nextElement()
Redlines(i) = new RedlineType
RedlineType = oRedline.RedlineType
if RedlineType ="Delete" or RedlineType ="Format" or RedlineType ="Insert" then
with redlines(i)
.RedlineType= RedlineType
.RedlineAuthor= oRedline.RedlineAuthor
.RedlineDateTime = oRedline.RedlineDateTime
.RedlineComment = oRedline.RedlineComment
' RedlineIdentifier as string
.IsInHeaderFooter= oRedline.IsInHeaderFooter
'RedlineText provides access to the text of the redline. This interface is only provided if the change is not visible. The visibility depends on the redline display options that are set at the documents property set (RedlineDisplayType).
.MergeLastPara = oRedline.MergeLastPara
.redlinestart = oRedline.redlinestart
.redlineend = oRedline.redlineend
'
if isempty( oRedline.redlinestart.TextTable(0)) then
TC = doc.Text.createTextCursorByRange(oRedline.redlinestart)
else
RCell=oRedline.redlinestart.cell
TC=RCell.CreateTextCursorByRange(RCell.start)
end if
TC.gotorange(oRedline.redlinestart,false)
TC.gotorange(oRedline.redlineend,true)
.cstring =TC.string
.CharOverline= TC.CharOverline
.CharColor = TC.CharColor
end with
with TC
.CharOverline=7 'DASHdot
select case RedlineType
case "Delete"
.collapsetoend
.string= redlines(i).cstring
.CharColor = DeleteCharColor
case "Insert"
.CharColor = InsertCharColor
case "Format"
.CharColor = FormatCharColor
end select
END WITH
i=i+1
end if
Loop
End Sub
Sub PasteWithRedlines(NewDoc)
setWinPointer NewDoc,2 'wait
On Error goto hr
NewDoc.lockControllers
WITH newdoc
if hasRedlines = false then
.CurrentController.insertTransferable(trans)
else
.UndoManager.enterUndoContext "Insert with changes"
.RecordChanges = false
.RedlineDisplayType =0
.CurrentController.insertTransferable(trans)
.RedlineDisplayType =0
GetOverlines NewDoc ,7
.UndoManager.leaveUndoContext
end if
END WITH
setWinPointer NewDoc,3 'Text
hr:
NewDoc.unlockControllers
end sub
'search replace part loosely adapted from 'https://forum.openoffice.org/en/forum/viewtopic.php?f=20&t=75449 (JohnSUN-Pensioner)
Sub GetOverlines(Doc, overlinetype)
dim aRedlineProperties(4) as new com.sun.star.beans.PropertyValue, i,j
Dim oSearch As Variant , oFound As Variant , SrchAttributes(0) As New com.sun.star.beans.PropertyValue,RedlineRange As Variant
oSearch = doc.createSearchDescriptor()
oSearch.SearchString = ".*" 'Regular expression. Match any text
oSearch.SearchRegularExpression=True 'Use regular expressions
SrchAttributes(0).Name = "CharOverline"
SrchAttributes(0).Value =overlinetype 'com.sun.star.awt.FontOverline.BOLD
oSearch.SetSearchAttributes(SrchAttributes())
oFound = doc.findAll(oSearch)
If not IsNull(oFound) Then
For i = 0 To oFound.getCount()-1
RedlineRange = oFound.getByIndex(i)
Select case RedlineRange.CharColor
case DeleteCharColor,InsertCharColor,FormatCharColor
with Redlines(j)
aRedlineProperties(0).Name = "RedlineAuthor"
aRedlineProperties(0).Value = .RedlineAuthor
aRedlineProperties(1).Name = "RedlineComment"
aRedlineProperties(1).Value = .RedlineComment
aRedlineProperties(2).Name = "RedlineDateTime"
aRedlineProperties(2).Value = .RedlineDateTime
'RedlineIdentifier as string 'contains a unique identifier for the redline. This is necessary for file export filters to able to recognize redline portions that point to the same redline.
aRedlineProperties(3).Name = "IsInHeaderFooter"
aRedlineProperties(3).Value = .IsInHeaderFooter
aRedlineProperties(4).Name = "MergeLastPara"
aRedlineProperties(4).Value = .MergeLastPara
on error resume next
RedlineRange.makeRedline(.RedlineType, aRedlineProperties )
RedlineRange.CharOverline = .CharOverline
RedlineRange.CharColor=.CharColor
end with
j=j+1
if j> ubredlines then exit for
end select
next
end if
End Sub
'HELPER
Sub setWinPointer(Doc, Ptype)
dim oPointer
oPointer = createUnoService("com.sun.star.awt.Pointer")
oPointer.setType(Ptype)
Doc.currentcontroller.frame.getcontainerwindow.setPointer(oPointer)
End Sub
'to do
'- exit if no selection
'-restore selection state, changes states
'full selection if table start
Option Explicit
private type RedlineType 'my custom type
RedlineAuthor as string 'the name of the author of the change.
RedlineDateTime as com.sun.star.util.DateTime 'date and time of the change.
RedlineComment as string ' comment for the change.
RedlineType as string 'Insert, Delete, Format , TextTable, Style
'RedlineSuccessorData 'com.sun.star.beans.PropertyValues RedlineSuccessorData; second level redline data The elements of the sequence are string RedlineAuthor; com::sun::star::util::DateTime RedlineDateTime; string RedlineComment; string RedlineType;
RedlineIdentifier as string 'contains a unique identifier for the redline. This is necessary for file export filters to able to recognize redline portions that point to the same redline.
IsInHeaderFooter as boolean 'boolean IsInHeaderFooter; determines whether the portion is member of a header or footer text.
'RedlineText XText RedlineText;the text of the redline. Only provided if the change is not visible. The visibility depends on the redline display options that are set at the documents property set (RedlineDisplayType).
MergeLastPara as boolean 'whether the last paragraph of a redline text has to be merged with a possible following text content (i.e. a text table)
CharOverline as long
CharColor as long
redlinestart as NEW com.sun.star.text.textrange
redlineend as NEW com.sun.star.text.textrange
cstring as string
end type
Global Redlines(),ubredlines as long,trans ,hasRedlines as boolean
Global DeleteCharColor as long,InsertCharColor as long,FormatCharColor as long,ColorsSet as boolean
sub testsub()
dim Doc,NewDoc
Doc = ThisComponent
NewDoc = StarDesktop.loadComponentFromURL("private:factory/swriter","_blank",0,Array())
CopyWithRedlines(doc)
PasteWithRedlines NewDoc
end sub
sub CopyWithRedlines(doc)
setWinPointer Doc,2 'WAIT
' oVC = thisComponent.getCurrentController.getViewCursor
' TC = oVC.getText.createTextCursorByRange(oVC)
On Error goto hr
Doc.lockControllers
with doc
hasRedlines=.getredlines.haselements
if hasRedlines =false then
trans = .currentcontroller.gettransferable
else
UBREDLINES = -1
if ColorsSet = false then
DeleteCharColor = rgb(50,50,50)
InsertCharColor = rgb(100,100,100)
FormatCharColor = rgb(150,150,150)
ColorsSet = true
end if
.UndoManager.enterUndoContext "Copy"
.RedlineDisplayType =2 'inserted and removed
.RecordChanges = false
getallRedlines Doc
trans = .currentcontroller.gettransferable
thiscomponent.RedlineDisplayType =0 'inserted and removed
with doc.UndoManager
.leaveUndoContext
.undo
.clearRedo
end with
end if
end with ' doc.currentcontroller.select(TC)
setWinPointer Doc,3 'Text
hr:
Doc.unlockControllers
end sub
Sub GetallRedlines(doc)
dim ORedlines,i,RedlineEnum, oRedline, RedlineType as string,RCell, TC
if doc.getredlines.haselements =false then exit sub '
' TC = doc.gettext.createtextcursor
oRedlines = doc.getredlines
ubredlines = oRedlines.count-1
redim redlines(ubredlines)
RedlineEnum = oRedlines.createEnumeration()
Do While RedlineEnum.hasMoreElements()
oRedline = RedlineEnum.nextElement()
Redlines(i) = new RedlineType
RedlineType = oRedline.RedlineType
if RedlineType ="Delete" or RedlineType ="Format" or RedlineType ="Insert" then
with redlines(i)
.RedlineType= RedlineType
.RedlineAuthor= oRedline.RedlineAuthor
.RedlineDateTime = oRedline.RedlineDateTime
.RedlineComment = oRedline.RedlineComment
' RedlineIdentifier as string
.IsInHeaderFooter= oRedline.IsInHeaderFooter
'RedlineText provides access to the text of the redline. This interface is only provided if the change is not visible. The visibility depends on the redline display options that are set at the documents property set (RedlineDisplayType).
.MergeLastPara = oRedline.MergeLastPara
.redlinestart = oRedline.redlinestart
.redlineend = oRedline.redlineend
'
if isempty(oRedline.redlinestart.TextTable(0)) = false then
RCell=oRedline.redlinestart.cell
TC=RCell.CreateTextCursorByRange(RCell.start)
elseif isempty(oRedline.redlinestart.TextFrame(0))=false then
TC = oRedline.redlinestart.TextFrame(0).text.createTextCursorByRange(oRedline.redlinestart)
else
TC = doc.Text.createTextCursorByRange(oRedline.redlinestart)
end if
TC.gotorange(oRedline.redlinestart,false)
TC.gotorange(oRedline.redlineend,true)
.cstring =TC.string
.CharOverline= TC.CharOverline
.CharColor = TC.CharColor
end with
with TC
.CharOverline=7 'DASHdot
select case RedlineType
case "Delete"
.collapsetoend
.string= redlines(i).cstring
.CharColor = DeleteCharColor
case "Insert"
.CharColor = InsertCharColor
case "Format"
.CharColor = FormatCharColor
end select
END WITH
i=i+1
end if
Loop
End Sub
Sub PasteWithRedlines(NewDoc)
setWinPointer NewDoc,2 'wait
On Error goto hr
NewDoc.lockControllers
WITH NewDoc
if hasRedlines = false then
.CurrentController.insertTransferable(trans)
else
.UndoManager.enterUndoContext "Insert with changes"
.RecordChanges = false
.RedlineDisplayType =0
'.CurrentController.Frame.containerWindow.setFocus()
'.CurrentController.Frame.ContainerWindow.toFront()
.CurrentController.insertTransferable(trans)
.RedlineDisplayType =0
GetOverlines NewDoc ,7
.UndoManager.leaveUndoContext
end if
END WITH
setWinPointer NewDoc,3 'Text
hr:
NewDoc.unlockControllers
end sub
'search replace part loosely adapted from 'https://forum.openoffice.org/en/forum/viewtopic.php?f=20&t=75449 (JohnSUN-Pensioner)
Sub GetOverlines(Doc, overlinetype)
dim aRedlineProperties(4) as new com.sun.star.beans.PropertyValue, i,j
Dim oSearch As Variant , oFound As Variant , SrchAttributes(0) As New com.sun.star.beans.PropertyValue,RedlineRange As Variant
oSearch = doc.createSearchDescriptor()
oSearch.SearchString = ".*" 'Regular expression. Match any text
oSearch.SearchRegularExpression=True 'Use regular expressions
SrchAttributes(0).Name = "CharOverline"
SrchAttributes(0).Value =overlinetype 'com.sun.star.awt.FontOverline.BOLD
oSearch.SetSearchAttributes(SrchAttributes())
oFound = doc.findAll(oSearch)
If not IsNull(oFound) Then
For i = 0 To oFound.getCount()-1
RedlineRange = oFound.getByIndex(i)
Select case RedlineRange.CharColor
case DeleteCharColor,InsertCharColor,FormatCharColor
with Redlines(j)
aRedlineProperties(0).Name = "RedlineAuthor"
aRedlineProperties(0).Value = .RedlineAuthor
aRedlineProperties(1).Name = "RedlineComment"
aRedlineProperties(1).Value = .RedlineComment
aRedlineProperties(2).Name = "RedlineDateTime"
aRedlineProperties(2).Value = .RedlineDateTime
'RedlineIdentifier as string 'contains a unique identifier for the redline. This is necessary for file export filters to able to recognize redline portions that point to the same redline.
aRedlineProperties(3).Name = "IsInHeaderFooter"
aRedlineProperties(3).Value = .IsInHeaderFooter
aRedlineProperties(4).Name = "MergeLastPara"
aRedlineProperties(4).Value = .MergeLastPara
on error resume next
RedlineRange.makeRedline(.RedlineType, aRedlineProperties )
RedlineRange.CharOverline = .CharOverline
RedlineRange.CharColor=.CharColor
end with
j=j+1
if j> ubredlines then exit for
end select
next
end if
End Sub
'HELPER
Sub setWinPointer(Doc, Ptype)
dim oPointer
oPointer = createUnoService("com.sun.star.awt.Pointer")
oPointer.setType(Ptype)
Doc.currentcontroller.frame.getcontainerwindow.setPointer(oPointer)
End Sub
Return to OpenOffice Basic, Python, BeanShell, JavaScript
Users browsing this forum: No registered users and 1 guest