litvinovg/cleanandvalidate
1
0
Fork 0
Code Issues 4 Pull requests Projects Releases 50 Packages Wiki Activity Actions

Fixes for link removal macro

Browse source
This commit is contained in:
George Litvinov 2019-10-29 16:17:08 +03:00
parent d5ba33005f
commit 6e1794a27e
1 changed files with 32 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

44
IPHRedaction/Clean.xba
View file

@ -1,6 +1,9 @@
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Clean" script:language="StarBasic">Sub cleanButton
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Clean" script:language="StarBasic">Private Sub markFxFxF
End Sub
Sub cleanButton
Dim description As String
Dim statusIndicator as Object
statusIndicator = ThisComponent.getCurrentController.statusIndicator
@ -188,7 +191,7 @@ End Function
Private Sub disposeAllLinks()
Dim SrchAttributes(0) as new com.sun.star.beans.PropertyValue
SrchAttributes(0).Name = &quot;CharStyleName&quot;
SrchAttributes(0).Value = &quot;Internet Link&quot;
SrchAttributes(0).Value = &quot;Internet link&quot;
Dim ReplAttributes(2) as new com.sun.star.beans.PropertyValue
ReplAttributes(0).Name = &quot;HyperlinkTarget&quot;
ReplAttributes(0).Value = &quot;&quot;
@ -196,7 +199,7 @@ Private Sub disposeAllLinks()
ReplAttributes(1).Value = &quot;&quot;
ReplAttributes(2).Name = &quot;CharStyleName&quot;
ReplAttributes(2).Value = ThisComponent.getStyleFamilies().getByIndex(0).ElementNames(0)
setAttributesBySearchPattern(searchPattern,SrchAttributes,ReplAttributes)
setAttributesBySearchPattern(&quot;&quot;,SrchAttributes,ReplAttributes)
End Sub
Private Sub disposeAllBookmarks()
@ -239,6 +242,8 @@ Private Sub setAttributesBySearchPattern(searchPattern As String, SrchAttributes
Dim oTextCursor As Object
Dim oViewCursor As Object
Dim lineIndent
dim stringValue1 As String
dim stringValue2 As String
Dim foundPatterns() As Object
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService(&quot;com.sun.star.frame.DispatchHelper&quot;)
@ -251,15 +256,30 @@ Private Sub setAttributesBySearchPattern(searchPattern As String, SrchAttributes
oSearch.SetSearchAttributes(SrchAttributes())
End If
oFound = ThisComponent.findFirst(oSearch)
Dim replace As Boolean
Do While Not IsNull(oFound)
For i = LBound(ReplAttributes) To Ubound(ReplAttributes)
&apos; Globalscope.BasicLibraries.LoadLibrary( &quot;MRILib&quot; )
&apos; Mri oFound
If oFound.getPropertySetInfo.hasPropertyByName(ReplAttributes(i).Name) Then
oFound.SetPropertyValue(ReplAttributes(i).Name,ReplAttributes(i).Value)
EndIf
Next i
oFound = ThisComponent.findNext(oFound.End, oSearch)
replace = true
For j = LBound(SrchAttributes) To Ubound(SrchAttributes)
If oFound.getPropertySetInfo.hasPropertyByName(SrchAttributes(j).Name) Then
stringValue1 = &quot;&quot; &amp; oFound.getPropertyValue(SrchAttributes(j).Name)
stringValue2 = &quot;&quot; &amp; SrchAttributes(j).Value
If stringValue1 &lt;&gt; stringValue2 Then
replace = replace AND False
EndIf
Else
replace = replace AND False
EndIf
Next j
If replace then
For i = LBound(ReplAttributes) To Ubound(ReplAttributes)
If oFound.getPropertySetInfo.hasPropertyByName(ReplAttributes(i).Name) Then
oFound.SetPropertyValue(ReplAttributes(i).Name,ReplAttributes(i).Value)
EndIf
Next i
EndIf
oFound = ThisComponent.findNext(oFound.End, oSearch)
Loop
End Sub
@ -785,4 +805,4 @@ Private Function getStyleNames(oFamily,bLocalized as Boolean, _
Endif
xArray(iUB) = vNextElement
End Sub
</script:module>
</script:module>