cleanandvalidate/IPHRedaction/Clean.xba

<?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">Private Sub markFxFxF
End Sub

Sub cleanButton
	Dim description As String
	Dim statusIndicator as Object
	statusIndicator = ThisComponent.getCurrentController.statusIndicator
	description = &quot;Вы уверены, что хотите выполнить чистку документа?&quot;
	If NOT confirm(description) Then
		Exit Sub
	EndIf
	saveDocument
	doNotTrack
	statusIndicator.Start(&quot;Чистка документа начата, подождите&quot;,30)
	
	convertFontsToCharStyles
	cleanFormatting
	disposeAllLinks
	disposeAllBookmarks
	fixTableWidth
	fixDrawingAnchors
	fixFrequentMistakes
	loadArticleStyles
	statusIndicator.end()
	saveAndreload()
End Sub


&apos;Replaces manual formatting text with font into character style with assigned font
Private Sub convertFontsToCharStyles
	Dim oDoc
	oDoc = Thiscomponent
	Dim srch(0) as new com.sun.star.beans.PropertyValue
	SDesc = Thiscomponent.createSearchDescriptor()
	  SDesc.SearchAll = true
	  SDesc.ValueSearch = false
	  SDesc.SearchStyles = false 
	  SDesc.SearchRegularExpression = false
	  SDesc.SearchString = &quot;&quot; 
	  srch(0).Name = &quot;CharFontName&quot;
	  SDesc.SetSearchAttributes(srch())
	  founds = Thiscomponent.findFirst(SDesc)
	  do while not isNull(founds)
	    curFont = founds.CharFontName
        If Not DocHasCharStyle(oDoc,curFont) Then
	        oProps() = Array(CreateProperty(&quot;CharFontName&quot;, curFont))
			CreateCharacterStyle(curFont, oProps())
		End If
	    founds.CharStyleNames = Array(curFont)
	    founds = Thiscomponent.findNext(founds.getend, SDesc)
	  loop
End Sub

Private Sub fixFrequentMistakes
	Dim NBSP As String
	Dim space As String
	NBSP = &quot; &quot;
	space = &quot; &quot;
	&apos;Не должно быть символов табуляции
    AskAndReplace(&quot;\t&quot;,&quot;&quot;)
    &apos;Не должно быть подряд больше одного пробела
    AskAndReplace(&quot;(?&lt;=[:space:])[:space:]+&quot;,&quot;&quot;)
	&apos;Не должно быть ни одного пробела в начале абзацев
    AskAndReplace(&quot;^[:space:]+&quot;,&quot;&quot;)
    &apos;Не должно быть пробелов в конце абзацев
    AskAndReplace(&quot;[:space:]+$&quot;,&quot;&quot;)
    &apos;Не должно быть пустых абзацев
    AskAndReplace(&quot;^$&quot;,&quot;&quot;)
    &apos;Не должно быть пробелов перед знаками пунктуации .,;:?!)]}»¡¿”‘’
   	AskAndReplace(&quot;[:space:]+(?=[\.,;:?!\)\]\}»¡¿”‘’])&quot;,&quot;&quot;)
	&apos;Между словом том и цифрой должен быть неразрывный пробел, а не обычный
	AskAndReplace(&quot;(?&lt;=\b[тТ](ом|\.))\ (?=[:digit:])&quot;,NBSP)
	&apos;Между словом серия и цифрой должен быть неразрывный пробел, а не обычный
	AskAndReplace(&quot;(?&lt;=\b[сС](ерия|\.))\ +(?=[:digit:])&quot;,NBSP)
	&apos;Между словом часть и цифрой должен быть неразрывный пробел, а не обычный
	AskAndReplace(&quot;(?&lt;=\b[чЧ](асть|\.))\ +(?=[:digit:])&quot;,NBSP)
	&apos;Между числом и &quot;г.&quot; должен быть неразрывный пробел, а не обычный
	AskAndReplace(&quot;(?&lt;=[0-9])[:space:]*г(?=\.)&quot;,NBSP &amp; &quot;г&quot;)
	&apos;Между инициалами и Фамилией должен быть неразрывный пробел, а не обычный
	AskAndReplace(&quot;(?&lt;=[:upper:]\.[:space:][:upper:]\.)\ (?=[:upper:][:lower:]+)&quot;,NBSP)
	&apos;Между Фамилией и инициалами должен быть неразрывный пробел, а не обычный
	AskAndReplace(&quot;(?&lt;=[:upper:][:lower:]{1,30})\ (?=[:upper:]\.[:space:][:upper:]\.)&quot;,NBSP)

	&apos;Не должно быть пробелов после скобок [({ и кавычек «„
	AskAndReplace(&quot;(?&lt;=[\(\[\{«„])[:space:]&quot;,&quot;&quot;)
	&apos;Между &quot;и&quot; и &quot;т.&quot; должен быть неразрывный пробел, а не обычный
    AskAndReplace(&quot;(?&lt;=\bи)\ (?=т\.)&quot;,NBSP)
   	&apos;Между &quot;т.&quot; и &quot;е./н./д./п./к.&quot; должен быть неразрывный пробел, а не обычный
    AskAndReplace(&quot;(?&lt;=\bт)\.\ ?(?=[ендпк]\.)&quot;,&quot;.&quot; &amp; NBSP)
    
   	&apos;Между буквами среднее тире должно обрамляться пробелами
	AskAndReplace(&quot;(?&lt;=[:alpha:])–(?=[:alpha:])&quot;,NBSP &amp; &quot;–&quot; &amp; NBSP)
	&apos;Между буквами дефис-минус, цифровое тире и длинное тире заменяется на среднее тире
    AskAndReplace(&quot;(?&lt;=[:alpha:][:space:])[-‒—](?=[:space:][:alpha:])&quot;,&quot;–&quot;)
    &apos;Между двумя цифрами и тире между ними не долнжо быть пробелов. А также тире должно быть цифровым
  	AskAndReplace(&quot;(?&lt;=[:digit:])(?:[:space:])?[-‒–—](?:[:space:])?(?=[:digit:])&quot;,&quot;‒&quot;)
 	
 	&apos;Между двумя римскими цифрами и тире между ними не долнжо быть пробелов. А также тире должно быть средним
	AskAndReplace(&quot;(?&lt;=[MDCLXVI])(?:[:space:])?[-‒–—](?:[:space:])?(?=[MDCLXVI])&quot;,&quot;–&quot;)
	
	&apos;Между буквой и угловой открывающейся скобкой должен быть пробел
	AskAndReplace(&quot;(?&lt;=[:alpha:])&lt;(?=…&gt;)&quot;,space &amp; &quot;&lt;&quot;)
	&apos;Между угловой закрывающейся скобкой и буквой должен быть пробел
	AskAndReplace(&quot;(?&lt;=&lt;…)&gt;(?=[:alpha:])&quot;,&quot;&gt;&quot; &amp; space)
End Sub

Private Sub loadArticleStyles
        Dim dispatcher as object
        Dim fileePath As String
        Dim fileTest As Object
        Dim fileName As String
        Dim aArgs(0)  As New com.sun.star.beans.PropertyValue
        fileName = &quot;Статья.ott&quot;
        filePath = getTemplatePath() &amp; &quot;/&quot; &amp; fileName
        fileTest = CreateUnoService(&quot;com.sun.star.ucb.SimpleFileAccess&quot;)
        If NOT fileTest.exists(filePath) Then
                MsgBox &quot;Файл стилей &quot; &amp; fileName &amp; &quot; не добавлен в Мои шаблоны. Не могу загрузить стили в текущий файл.&quot;
                Exit Sub
        EndIf
        dispatcher = createUnoService(&quot;com.sun.star.frame.DispatchHelper&quot;)
    aArgs(0).Name = &quot;OverwriteStyles&quot;
    aArgs(0).Value = True
    ThisComponent.StyleFamilies.loadStylesFromURL( filePath, aArgs() )
End Sub

Private Sub CreateCharacterStyle(sStyleName$, oProps())
	Dim i%
	Dim oFamilies
	Dim oStyle
	Dim oStyles
	oFamilies = ThisComponent.StyleFamilies
	oStyles = oFamilies.getByName(&quot;CharacterStyles&quot;)
	If oStyles.HasByName(sStyleName) Then
	  Exit Sub
	End If
	oStyle = ThisComponent.createInstance(&quot;com.sun.star.style.CharacterStyle&quot;)
	For i=LBound(oProps) To UBound(oProps)
	  oStyle.setPropertyValue(oProps(i).Name, oProps(i).Value)
	Next
	oStyles.insertByName(sStyleName, oStyle)
End Sub

Private Function CreateProperty( Optional cName As String, Optional uValue ) As com.sun.star.beans.PropertyValue
	Dim oPropertyValue As New com.sun.star.beans.PropertyValue
	If Not IsMissing( cName ) Then
	  oPropertyValue.Name = cName
	EndIf
	If Not IsMissing( uValue ) Then
	  oPropertyValue.Value = uValue
	EndIf
	CreateProperty() = oPropertyValue
End Function

Private Sub AskAndReplace(SearchString, oReplaceString)
	Dim SrchAttributes(0) as new com.sun.star.beans.PropertyValue
	Dim ReplAttributes(0) as new com.sun.star.beans.PropertyValue
	ReplaceFormatting(SearchString,oReplaceString,SrchAttributes,ReplAttributes, true)
End Sub

Private Function DocHasCharStyle(oDoc, sName$) As Boolean
	Dim oStyles
	oStyles = oDoc.StyleFamilies.getByName(&quot;CharacterStyles&quot;)
	DocHasCharStyle() = oStyles.hasByName(sName)
End Function


Private Function getTemplatePath() as String
        Dim ath as String
        Dim settings As Object
        Dim configProvider As Object
        Dim params(0) As new com.sun.star.beans.PropertyValue
        Dim convService As Object

        configProvider = createUnoService( &quot;com.sun.star.configuration.ConfigurationProvider&quot; )
        params(0).Name = &quot;nodepath&quot;
        params(0).Value = &quot;/org.openoffice.Office.Paths/Paths&quot;
        settings = configProvider.createInstanceWithArguments(&quot;com.sun.star.configuration.ConfigurationAccess&quot;, params() )

        path = settings.Template.WritePath
        convService = CreateUnoService(&quot;com.sun.star.util.PathSubstitution&quot;)
        path = convService.substituteVariables(path, true)
        path = ConvertToUrl(path)
        getTemplatePath = path

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;
	Dim ReplAttributes(2) as new com.sun.star.beans.PropertyValue
	ReplAttributes(0).Name = &quot;HyperlinkTarget&quot;
	ReplAttributes(0).Value = &quot;&quot;
	ReplAttributes(1).Name = &quot;HyperLinkURL&quot;
	ReplAttributes(1).Value = &quot;&quot;
	ReplAttributes(2).Name = &quot;CharStyleName&quot;
	ReplAttributes(2).Value = ThisComponent.getStyleFamilies().getByIndex(0).ElementNames(0)
	setAttributesBySearchPattern(&quot;&quot;,SrchAttributes,ReplAttributes)
End Sub

Private Sub disposeAllBookmarks()
	Dim bookmarks As Object
	Dim elementName As String
	elementName = ThisComponent.Links.ElementNames(6)
	bookmarks = ThisComponent.Links.getByName(elementName)
	While bookmarks.hasElements()
		bookmark = bookmarks.getByName(bookmarks.ElementNames(0))
		bookmark.dispose()
	Wend
End Sub


Private Sub disposePageBreaks
	oTextCursor = ThisComponent.Text.CreateTextCursor()
	enum1 = ThisComponent.Text.createEnumeration
	While enum1.hasMoreElements
		enum1Element = enum1.nextElement
		If enum1Element.supportsService(&quot;com.sun.star.text.Paragraph&quot;) Then
			If enum1Element.BreakType &lt;&gt; com.sun.star.style.BreakType.NONE Then
				oTextCursor.goToRange(enum1Element.getAnchor(), false)
				If NOT IsEmpty(oTextCursor.PageDescName) Then
					oTextCursor.PageDescName = &quot;&quot;
				End If
				oTextCursor.BreakType = com.sun.star.style.BreakType.NONE
			End If
		ElseIf enum1Element.supportsService(&quot;com.sun.star.text.TextTable&quot;) Then
			If NOT IsEmpty(enum1Element.PageDescName) Then
				enum1Element.PageDescName = &quot;&quot;
			End If
			enum1Element.BreakType = com.sun.star.style.BreakType.NONE
		EndIf
	Wend
End Sub

Private Sub setAttributesBySearchPattern(searchPattern As String, SrchAttributes, ReplAttributes)
	
	Dim oSearch
	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;)
	oSearch = ThisComponent.createSearchDescriptor()
	oSearch.SearchString = searchPattern
	oSearch.SearchRegularExpression=True
    oSearch.SearchAll = True
    oSearch.searchStyles = true
    If Not IsEmpty(SrchAttributes(0).Value) Then
      oSearch.SetSearchAttributes(SrchAttributes())
    End If
	oFound = ThisComponent.findFirst(oSearch)
	Dim replace As Boolean

	Do While Not IsNull(oFound)
		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

Private Sub saveAndreload()

	dim document   as object
	dim dispatcher as object
	document   = ThisComponent.CurrentController.Frame
	dispatcher = createUnoService(&quot;com.sun.star.frame.DispatchHelper&quot;)
	dispatcher.executeDispatch(document, &quot;.uno:Save&quot;, &quot;&quot;, 0, Array())
	dispatcher.executeDispatch(document, &quot;.uno:Reload&quot;, &quot;&quot;, 0, Array())

End Sub

Private Sub saveDocument()

	dim document   as object
	dim dispatcher as object
	document   = ThisComponent.CurrentController.Frame
	dispatcher = createUnoService(&quot;com.sun.star.frame.DispatchHelper&quot;)
	dispatcher.executeDispatch(document, &quot;.uno:Save&quot;, &quot;&quot;, 0, Array())

end Sub

Private Sub cleanFormatting

	&apos;Не должно быть символов табуляции
    AskAndReplace(&quot;\t&quot;,&quot;&quot;)
    &apos;Не должно быть подряд больше одного пробела
    AskAndReplace(&quot;(?&lt;=[:space:])[:space:]+&quot;,&quot;&quot;)
	&apos;Не должно быть ни одного пробела в начале абзацев
    AskAndReplace(&quot;^[:space:]+&quot;,&quot;&quot;)
    &apos;Не должно быть пустых абзацев
    AskAndReplace(&quot;^$&quot;,&quot;&quot;)

	replaceBaseWithStandard
	
	convertFormattingToText
	
	manualFontsToCharStyle
	
	removeDirectFormatting
	
	convertFormattingFromText
	
	resetFootnotesStyle
	
	removeUnusedStyles

End Sub

Private Sub fixTableWidth()
	Dim table As Object
	Dim tables As Object
	tables = ThisComponent.TextTables
	Dim count As Long
	count = ThisComponent.TextTables.getCount()
	For i = 0 To count - 1
		table = tables.getByIndex(i)
		If table.HoriOrient = 6 Then
			table.HoriOrient = 2
		EndIf
		If table.RelativeWidth = 0 Then
			table.RelativeWidth = 100
		EndIf
	Next
End Sub

Private Sub fixDrawingAnchors()
	Dim drawing As Object
	Dim drawings As Object
	drawings = ThisComponent.DrawPage
	Dim count As Long
	count = drawings.getCount()
	For i = 0 To count - 1
		drawing = drawings.getByIndex(i)
		If drawing.AnchorType= com.sun.star.text.TextContentAnchorType.AT_PAGE Then
			drawing.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
		EndIf
	Next
End Sub

Sub manualFontsToCharStyle
	Dim oDoc
	oDoc = Thiscomponent
	Dim srch(0) as new com.sun.star.beans.PropertyValue
	SDesc = Thiscomponent.createSearchDescriptor()
	  SDesc.SearchAll = true
	  SDesc.ValueSearch = false
	  SDesc.SearchStyles = false 
	  SDesc.SearchRegularExpression = false
	  SDesc.SearchString = &quot;&quot; 
	  srch(0).Name = &quot;CharFontName&quot;
	  SDesc.SetSearchAttributes(srch())
	  founds = Thiscomponent.findFirst(SDesc)
	  do while not isNull(founds)
	    curFont = founds.CharFontName
	    If curFont &lt;&gt; &quot;IPH Astra Serif&quot; AND curFont &lt;&gt; &quot;&quot; Then
	      If Not DocHasCharStyle(oDoc,curFont) Then
	        oProps() = Array(CreateProperty(&quot;CharFontName&quot;, curFont))
	        CreateCharacterStyle(curFont, oProps())
	      End If
	      founds.CharStyleNames = Array(curFont)
	    End If
	    founds = Thiscomponent.findNext(founds.getend, SDesc)
	  loop
End Sub

Private Sub replaceBaseWithStandard
	replaceParaStyle(&quot;Базовый&quot;,&quot;Основной текст&quot;)
	replaceParaStyle(&quot;Default Style&quot;,&quot;Text Body&quot;)
End Sub

Private Sub replaceParaStyle(oldStyleName,newStyleName)
	dim document   as Object
	dim dispatcher as object
	document   = ThisComponent.CurrentController.Frame
	dispatcher = createUnoService(&quot;com.sun.star.frame.DispatchHelper&quot;)
	dim args1(21) as new com.sun.star.beans.PropertyValue
	args1(0).Name = &quot;SearchItem.StyleFamily&quot;
	args1(0).Value = 2
	args1(1).Name = &quot;SearchItem.CellType&quot;
	args1(1).Value = 0
	args1(2).Name = &quot;SearchItem.RowDirection&quot;
	args1(2).Value = true
	args1(3).Name = &quot;SearchItem.AllTables&quot;
	args1(3).Value = false
	args1(4).Name = &quot;SearchItem.SearchFiltered&quot;
	args1(4).Value = false
	args1(5).Name = &quot;SearchItem.Backward&quot;
	args1(5).Value = false
	args1(6).Name = &quot;SearchItem.Pattern&quot;
	args1(6).Value = true
	args1(7).Name = &quot;SearchItem.Content&quot;
	args1(7).Value = false
	args1(8).Name = &quot;SearchItem.AsianOptions&quot;
	args1(8).Value = false
	args1(9).Name = &quot;SearchItem.AlgorithmType&quot;
	args1(9).Value = 0
	args1(10).Name = &quot;SearchItem.SearchFlags&quot;
	args1(10).Value = 65536
	args1(11).Name = &quot;SearchItem.SearchString&quot;
	args1(11).Value = oldStyleName
	args1(12).Name = &quot;SearchItem.ReplaceString&quot;
	args1(12).Value = newStyleName
	args1(13).Name = &quot;SearchItem.Locale&quot;
	args1(13).Value = 255
	args1(14).Name = &quot;SearchItem.ChangedChars&quot;
	args1(14).Value = 2
	args1(15).Name = &quot;SearchItem.DeletedChars&quot;
	args1(15).Value = 2
	args1(16).Name = &quot;SearchItem.InsertedChars&quot;
	args1(16).Value = 2
	args1(17).Name = &quot;SearchItem.TransliterateFlags&quot;
	args1(17).Value = 1280
	args1(18).Name = &quot;SearchItem.Command&quot;
	args1(18).Value = 3
	args1(19).Name = &quot;SearchItem.SearchFormatted&quot;
	args1(19).Value = false
	args1(20).Name = &quot;SearchItem.AlgorithmType2&quot;
	args1(20).Value = 1
	args1(21).Name = &quot;Quiet&quot;
	args1(21).Value = true
	dispatcher.executeDispatch(document, &quot;.uno:ExecuteSearch&quot;, &quot;&quot;, 0, args1())
End Sub

Private Sub doNotTrack
	dispatcher = createUnoService(&quot;com.sun.star.frame.DispatchHelper&quot;)
	document   = ThisComponent.CurrentController.Frame
	dim trackProperties(0) as new com.sun.star.beans.PropertyValue
	trackProperties(0).Name = &quot;TrackChanges&quot;
	trackProperties(0).Value = false
	dispatcher.executeDispatch(document, &quot;.uno:TrackChanges&quot;, &quot;&quot;, 0, trackProperties())
	dim args1(0) as new com.sun.star.beans.PropertyValue
	args1(0).Name = &quot;ShowTrackedChanges&quot;
	args1(0).Value = true
	dispatcher.executeDispatch(document, &quot;.uno:ShowTrackedChanges&quot;, &quot;&quot;, 0, args1())
End Sub

Private Sub removeDirectFormatting
	Dim oDescriptor &apos;The search descriptor
	dim dispatcher as Object
	dispatcher = createUnoService(&quot;com.sun.star.frame.DispatchHelper&quot;)
	dim document   as Object
	document   = ThisComponent.CurrentController.Frame
	Dim oViewCursor As Object &apos;View cursor
	oViewCursor = ThisComponent.CurrentController.getViewCursor()
 &apos;	Globalscope.BasicLibraries.LoadLibrary( &quot;MRILib&quot; )
&apos;	Mri oViewCursor
	oViewCursor.jumpToFirstPage()
	oViewCursor.gotoStart(false)
	oViewCursor.gotoEnd(true)
	dispatcher.executeDispatch(document, &quot;.uno:ResetAttributes&quot;, &quot;&quot;, 0, Array())
	footNotes = thisComponent.Footnotes
	For x = 0 to footNotes.Count -1
	  aNote = footNotes.getByIndex(x)
	  footNoteText = aNote.getText()
	  oTextcursor = footNoteText.createTextCursor()
	  oViewCursor.gotoRange(oTextcursor.getStart(),false) 
	  oViewCursor.gotoEnd(true)
	  dispatcher.executeDispatch(document, &quot;.uno:ResetAttributes&quot;, &quot;&quot;, 0, Array())
	Next
	endNotes = thisComponent.Endnotes
	for x = 0 to endNotes.Count -1
	  aNote = endNotes.getByIndex(x)
	  endNoteText = aNote.getText()
	  oTextcursor = endNoteText.createTextCursor()
	  oViewCursor.gotoRange(oTextcursor.getStart(),false) 
	  oViewCursor.gotoEnd(true)
	  dispatcher.executeDispatch(document, &quot;.uno:ResetAttributes&quot;, &quot;&quot;, 0, Array())
	next
	
	oViewCursor.gotoStart(false)
End Sub

Private Sub resetFootnotesStyle
	Dim oDescriptor &apos;The search descriptor
	dim dispatcher as Object
	dispatcher = createUnoService(&quot;com.sun.star.frame.DispatchHelper&quot;)
	dim document   as Object
	document   = ThisComponent.CurrentController.Frame
	Dim oViewCursor As Object &apos;View cursor
	oViewCursor = ThisComponent.CurrentController.getViewCursor()
	allNotes= thisComponent.FootNotes
	for x = 0 to allNotes.Count -1
	  aNote = allNotes.getByIndex(x)
	  aNote.Anchor.CharStyleName=&quot;Footnote anchor&quot;
	  oEnum = aNote.Text.createEnumeration()
	  Do While oEnum.hasMoreElements()
	    oCurPar = oEnum.nextElement()
	    oCurPar.ParaStyleName = &quot;Footnote&quot;
	  Loop
	Next
End Sub

Private Sub removeUnusedStyles
	&apos;calls: RemoveUnusedStyles
	Dim sElements() as string, oFamilies, oFamily, sFamily$, sLabel, oDlg, i%
	Dim oDoc as object
	oDoc = ThisComponent
	oFamilies = thiscomponent.StyleFamilies
	sElements() = oFamilies.getElementNames()
	For i = 0 to uBound(sElements()) -2
	   oFamily = oFamilies.getByName(sElements(i))
	   removeUnusedStyle(oFamily,sElements(i),True)
	Next
End Sub

Private Sub removeUnusedStyle(oFamily,sFamily as string, bAsk as Boolean)
	&apos;calls: getStyleNames
	Dim sUsed() as String, sMsg$,iAnswer%, bStop as boolean
	sUsed() = getStyleNames(oFamily,bLocalized:=True,bUsed:=False,bUserDef:=true)
	If uBound(sUsed()) &gt; -1 then
	         For i = 0 to uBound(sUsed())
	            oFamily.removeByName(sUsed(i))
	         Next
	EndIf
End Sub

Private Sub convertFormatToEnclosure(identifier, styleNames, styleValues)
	leftEnclosure = compileLeftEnclosure(identifier)
	rightEnclosure = compileRightEnclosure(identifier)
	Dim oTextCursor As Object
	Dim startTextRange As Object
	Dim endTextRange As Object
	Dim foundString As String
	Dim SrchAttributes(Ubound(styleNames)) as new com.sun.star.beans.PropertyValue
	For i = 0 To Ubound(styleNames)
		SrchAttributes(i).Name = styleNames(i)
		SrchAttributes(i).Value = styleValues(i)
	Next i
	SDesc = Thiscomponent.createSearchDescriptor()
	SDesc.SearchAll = true
	SDesc.SearchRegularExpression = true
	SDesc.SearchString = &quot;&quot;
	SDesc.searchStyles = false
	SDesc.SetSearchAttributes(SrchAttributes)
	found = Thiscomponent.findFirst(SDesc)
	  Do While not isNull(found)
	  	oTextCursor = found.Text.createTextCursor()
	  	oTextCursor.goToRange(found.Start, false)
	  	oTextCursor.goToRange(found.End, true)
  		For i = 0 To Ubound(styleNames)
			oTextCursor.setPropertyToDefault(styleNames(i))
		Next i
		foundString = found.getString()
		If Len(foundString) &lt;&gt; 0 Then
			oTextCursor.collapseToEnd()
			oTextCursor.String = rightEnclosure
			endTextRange = oTextCursor.getEnd()
			oTextCursor.goToRange(found.start,false)
			oTextCursor.String = leftEnclosure
		EndIf
		found = Thiscomponent.findNext(found.End, SDesc)
	  Loop
End Sub

Private Sub convertEnclosuresToFormat(identifier, styleNames, styleValues)
	Dim oTextCursor As Object
	Dim startTextRange As Object
	Dim endTextRange As Object
	Dim leftEnclosure As String
	Dim rightEnclosure As String
	leftEnclosure = compileLeftEnclosure(identifier)
	rightEnclosure = compileRightEnclosure(identifier)
	SDesc = Thiscomponent.createSearchDescriptor()
	SDesc.SearchAll = true
	SDesc.SearchRegularExpression = true
	SDesc.SearchString = leftEnclosure + &quot;([^&quot; + identifier+ &quot;]*)&quot; + rightEnclosure

	found = Thiscomponent.findFirst(SDesc)
	  Do While not isNull(found)
	  	oTextCursor = found.Text.createTextCursor()
	  	oTextCursor.goToRange(found.Start, false)
	  	oTextCursor.goToRange(found.End, true)
	  	oTextCursor.setPropertyValues(styleNames, styleValues)
	  	oTextCursor.collapseToEnd()
		oTextCursor.goLeft(Len(rightEnclosure), true)
		oTextCursor.String = &quot;&quot;
		endTextRange = oTextCursor.getEnd()
		oTextCursor.goToRange(found.start,false)
		oTextCursor.goRight(Len(leftEnclosure), true)
		oTextCursor.String = &quot;&quot;
		found = Thiscomponent.findNext(endTextRange, SDesc)
	  Loop
End Sub


Private Function compileSearchString(identifier)
	compileSearchString = &quot;&lt;&quot;+identifier+&quot;&gt;&quot;+&quot;(.*?)&quot;+&quot;&lt;/&quot;+identifier+&quot;&gt;&quot;
End Function

Private Function compileLeftEnclosure(identifier)
	compileLeftEnclosure = &quot;&lt;&quot;+identifier+&quot;&gt;&quot;
End Function

Private Function compileRightEnclosure(identifier)
	compileRightEnclosure = &quot;&lt;/&quot;+identifier+&quot;&gt;&quot;
End Function


Private Sub toTextBold
	styleNames = Array(&quot;CharWeight&quot;)
	styleValues = Array(com.sun.star.awt.FontWeight.BOLD)
	convertFormatToEnclosure(CHR(867), styleNames, styleValues)
End Sub

Private Sub fromTextBold
	styleNames = Array(&quot;CharWeight&quot;)
	styleValues = Array(com.sun.star.awt.FontWeight.BOLD)
	convertEnclosuresToFormat(CHR(867), styleNames, styleValues)
End Sub

Private Sub toTextItalic
	styleNames = Array(&quot;CharPosture&quot;)
	styleValues = Array(com.sun.star.awt.FontSlant.ITALIC)
	convertFormatToEnclosure(CHR(868), styleNames, styleValues)
End Sub

Private Sub fromTextItalic
	styleNames = Array(&quot;CharPosture&quot;)
	styleValues = Array(com.sun.star.awt.FontSlant.ITALIC)
	convertEnclosuresToFormat(CHR(868), styleNames, styleValues)
End Sub

Private Sub toTextStrikeout
	styleNames = Array(&quot;CharStrikeout&quot;)
	styleValues = Array(com.sun.star.awt.FontStrikeout.SINGLE)
	convertFormatToEnclosure(CHR(869), styleNames, styleValues)

End Sub

Private Sub fromTextStrikeout
	styleNames = Array(&quot;CharStrikeout&quot;)
	styleValues = Array(com.sun.star.awt.FontStrikeout.SINGLE)
	convertEnclosuresToFormat(CHR(869), styleNames, styleValues)
End Sub


Private Sub toTextUnderline
	styleNames = Array(&quot;CharUnderline&quot;)
	styleValues = Array(com.sun.star.awt.FontUnderline.SINGLE)
	convertFormatToEnclosure(CHR(870), styleNames, styleValues)
End Sub

Private Sub fromTextUnderline
	styleNames = Array(&quot;CharUnderline&quot;)
	styleValues = Array(com.sun.star.awt.FontUnderline.SINGLE)
	convertEnclosuresToFormat(CHR(870), styleNames, styleValues)
End Sub

Private Sub toTextSuperscript
	styleNames = Array(&quot;CharEscapementHeight&quot;,&quot;CharEscapement&quot;)
	styleValues = Array(58,101)
	convertFormatToEnclosure(CHR(871), styleNames, styleValues)
End Sub

Private Sub fromTextSuperscript
	styleNames = Array(&quot;CharEscapementHeight&quot;,&quot;CharEscapement&quot;)
	styleValues = Array(58,101)
	convertEnclosuresToFormat(CHR(871), styleNames, styleValues)
End Sub

Private Sub toTextSubscript
	styleNames = Array(&quot;CharEscapementHeight&quot;,&quot;CharEscapement&quot;)
	styleValues = Array(58,-101)
	convertFormatToEnclosure(CHR(872), styleNames, styleValues)
End Sub

Private Sub fromTextSubscript
	styleNames = Array(&quot;CharEscapementHeight&quot;,&quot;CharEscapement&quot;)
	styleValues = Array(58,-101)
	convertEnclosuresToFormat(CHR(872), styleNames, styleValues)
End Sub

Private Sub toTextSparce
	styleNames = Array(&quot;CharKerning&quot;)
	For i=70 To 70 
		styleValues = Array(i)
		convertFormatToEnclosure(CHR(873) &amp; i, styleNames, styleValues)
	Next
End Sub

Private Sub fromTextSparce
	styleNames = Array(&quot;CharKerning&quot;)
	For i=70 To 70 
		styleValues = Array(i)
		convertEnclosuresToFormat(CHR(873) &amp; i, styleNames, styleValues)
	Next 
End Sub


Private Sub convertFormattingToText
	toTextBold
	toTextItalic
	toTextStrikeout
	toTextUnderline
	toTextSuperscript
	toTextSubscript
	toTextSparce
End Sub

Private Sub convertFormattingFromText
	fromTextSparce
	fromTextSuperscript
	fromTextSubscript
	fromTextUnderline
	fromTextStrikeout
	fromTextItalic
	fromTextBold
End Sub

Private Function confirm(description)
	If MsgBox (description, 4) =6 Then
		confirm = true
	Else
		confirm = false
	EndIf
	
End Function

Private Sub ReplaceFormatting(SearchString,oReplaceString,SrchAttributes,ReplAttributes, searchStyles)
	Dim oReplace
	oReplace = ThisComponent.createReplaceDescriptor()
	oReplace.SearchString = SearchString
	oReplace.ReplaceString = oReplaceString
	oReplace.SearchRegularExpression=True
	oReplace.SearchCaseSensitive = True
	
	oReplace.searchAll=True
	If Not IsEmpty(SrchAttributes(0).Value) Then
	  oReplace.SetSearchAttributes(SrchAttributes())
	  oReplace.searchStyles = searchStyles
	End If
	If Not IsEmpty(ReplAttributes(0).Value) Then
	  oReplace.SetReplaceAttributes(ReplAttributes())
	End If
	ThisComponent.replaceAll(oReplace)
End Sub

Private Function getStyleNames(oFamily,bLocalized as Boolean, _
	   optional bUsed, optional bUserDef)
	Dim oStyle,i%,sNames$(),sName$,chkUse as Boolean, chkUDef as Boolean
	For i = 0 to oFamily.getCount -1
	   oStyle = oFamily.getByIndex(i)
	   If bLocalized then
	      sName = oStyle.DisplayName
	   Else
	      sName = oStyle.getName
	   Endif
	   If (vartype(bUsed) = 11)then
	      chkUse = (bUsed EQV oStyle.isInUse)
	   Else
	      chkUse = True
	   Endif
	   If (vartype(bUserDef) = 11) then
	      chkUDef = (bUserDef EQV oStyle.isUserDefined)
	   Else
	      chkUDef = True
	   EndIf
	   If sName = &quot;Автор&quot; Or sName = &quot;Автор по-английски&quot; Or sName = &quot;Ключевые слова&quot; Or sName = &quot;Текст списка литературы&quot; Or sName = &quot;Эпиграф&quot; or sName = &quot;Цитирование&quot; or sName = &quot;Сведения об авторе&quot; or sName = &quot;Аннотация&quot; Then
	     chkUse = False
	   Endif
	   If chkUse AND chkUDef then
	      bas_Pusharray sNames(),sName
	   Endif
	Next
	getStyleNames = sNames()
	End Function
	
	&apos;very simple routine appending some element to an array which can be undimensioned (LBound &gt; UBound)
	Sub bas_PushArray(xArray(),vNextElement)
	Dim iUB%,iLB%
	iLB = lBound(xArray())
	iUB = uBound(xArray())
	If iLB &gt; iUB then
	   iUB = iLB
	   redim xArray(iLB To iUB)
	Else
	   iUB = iUB +1
	   redim preserve xArray(iLB To iUB)
	Endif
	xArray(iUB) = vNextElement
End Sub
</script:module>