diff --git a/Redaction/Clean.xba b/Redaction/Clean.xba index 79c2013..c01fe36 100644 --- a/Redaction/Clean.xba +++ b/Redaction/Clean.xba @@ -1,6 +1,6 @@ -Sub mark33 +Sub mark34 End Sub @@ -28,7 +28,7 @@ Private Sub makerUpMenu Exit sub End Sub -Private Sub cleanAccordingTo(dialog) +Private Sub cleanAccordingTo(dialog As Object) Dim statusIndicator as Object statusIndicator = ThisComponent.getCurrentController.statusIndicator dialog.setVisible(false) @@ -141,6 +141,8 @@ Private Sub quietCleaning End Sub Private Sub removeFirstElementPageBreak + Dim enum1 As Object + Dim enum1Element As Object enum1 = ThisComponent.Text.createEnumeration If enum1.hasMoreElements Then enum1Element = enum1.nextElement @@ -163,12 +165,14 @@ Private Sub replaceStyleFonts replaceFontsInStyles("Palatino Linotype Greek","Tinos") End Sub -Private Sub replaceFontsInStyles(oldFontStart,newFontName) - ' Substitutes font names starts with oldFont value with newFont value - Dim oDoc as Object +Private Sub replaceFontsInStyles(oldFontStart As String,newFontName As String) Dim propertySetInfo As Object Dim oPositionOfMatch As Long - oDoc = ThisComponent + Dim oFamilies As Object + Dim sElements As Object + Dim oFamily As Object + Dim oStyle As Object + Dim fontName As String oFamilies = Thiscomponent.StyleFamilies sElements() = oFamilies.getElementNames() For i = 0 to oFamilies.count -1 @@ -183,10 +187,10 @@ Private Sub replaceFontsInStyles(oldFontStart,newFontName) oStyle.CharFontName = newFontName If propertySetInfo.hasPropertyByName("CharFontNameComplex") Then oStyle.CharFontNameComplex = newFontName - ENdIf + EndIf If propertySetInfo.hasPropertyByName("CharFontNameAsian") Then oStyle.CharFontNameAsian = newFontName - ENdIf + EndIf EndIf EndIf @@ -248,18 +252,19 @@ Private Sub unicodeSymbolsConversion End Sub -Private Sub unicodeConversionEverywhere(searchPattern,rAtts) - 'in text +Private Sub unicodeConversionEverywhere(searchPattern As String,rAtts) setAttributesBySearchPattern(searchPattern,RAtts) - End Sub 'Replaces manual formatting text with font into character style with assigned font Private Sub convertFontsToCharStyles - Dim oDoc - oDoc = Thiscomponent + Dim oDoc As Object + Dim SDesc As Object + Dim founds As Object + Dim curFont As String Dim srch(0) as new com.sun.star.beans.PropertyValue + oDoc = Thiscomponent SDesc = Thiscomponent.createSearchDescriptor() SDesc.SearchAll = true SDesc.ValueSearch = false @@ -294,9 +299,11 @@ End Sub Private Sub removeUserPageStyles Dim oStyles As Object Dim oStyle As Object - oStyles = ThisComponent.StyleFamilies.getByName("PageStyles") Dim count As Long + Dim i As Long + oStyles = ThisComponent.StyleFamilies.getByName("PageStyles") count = oStyles.count - 1 + For i = 0 to count oStyle = oStyles.getByIndex(i) If oStyle.isUserDefined Then @@ -366,29 +373,29 @@ Private Sub fixFrequentMistakes 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 = "Статья.ott" - filePath = getTemplatePath() & "/" & fileName - fileTest = CreateUnoService("com.sun.star.ucb.SimpleFileAccess") - If NOT fileTest.exists(filePath) Then - MsgBox "Файл стилей " & fileName & " не добавлен в Мои шаблоны. Не могу загрузить стили в текущий файл." - Exit Sub - EndIf - dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") + Dim dispatcher As Object + Dim filePath As String + Dim fileTest As Object + Dim fileName As String + Dim aArgs(0) As New com.sun.star.beans.PropertyValue + fileName = "Статья.ott" + filePath = getTemplatePath() & "/" & fileName + fileTest = CreateUnoService("com.sun.star.ucb.SimpleFileAccess") + If NOT fileTest.exists(filePath) Then + MsgBox "Файл стилей " & fileName & " не добавлен в Мои шаблоны. Не могу загрузить стили в текущий файл." + Exit Sub + EndIf + dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") aArgs(0).Name = "OverwriteStyles" aArgs(0).Value = True ThisComponent.StyleFamilies.loadStylesFromURL( filePath, aArgs() ) End Sub -Private Sub CreateCharacterStyle(sStyleName$, oProps()) - Dim i% - Dim oFamilies - Dim oStyle - Dim oStyles +Private Sub CreateCharacterStyle(sStyleName As String, oProps()) + Dim i As Integer + Dim oFamilies As Object + Dim oStyle As Object + Dim oStyles As Object oFamilies = ThisComponent.StyleFamilies oStyles = oFamilies.getByName("CharacterStyles") If oStyles.HasByName(sStyleName) Then @@ -412,21 +419,20 @@ Private Function CreateProperty( Optional cName As String, Optional uValue ) As CreateProperty() = oPropertyValue End Function -Private Sub AskAndReplace(SearchString, oReplaceString) +Private Sub AskAndReplace(SearchString As String, oReplaceString As String) 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 + Dim oStyles As Object oStyles = oDoc.StyleFamilies.getByName("CharacterStyles") DocHasCharStyle() = oStyles.hasByName(sName) End Function - Private Function getTemplatePath() as String - Dim ath as String + Dim path as String Dim settings As Object Dim configProvider As Object Dim params(0) As new com.sun.star.beans.PropertyValue @@ -448,20 +454,17 @@ End Function Private Sub removeHyperlinks() - Dim aNote As Object - - + Dim i As Long removeHLInText(ThisComponent.Text) - For x = 0 to ThisComponent.FootNotes.Count -1 + For i = 0 to ThisComponent.FootNotes.Count -1 aNote = ThisComponent.FootNotes.getByIndex(x) removeHLInText(aNote.Text) Next - For x = 0 to ThisComponent.EndNotes.Count -1 + For i = 0 to ThisComponent.EndNotes.Count -1 aNote = ThisComponent.EndNotes.getByIndex(x) removeHLInText(aNote.Text) Next - End Sub Private Sub removeHLInText(textElement) @@ -506,13 +509,16 @@ Private Sub disposeAllBookmarks() elementName = ThisComponent.Links.ElementNames(6) bookmarks = ThisComponent.Links.getByName(elementName) While bookmarks.hasElements() - bookmark = bookmarks.getByName(bookmarks.ElementNames(0)) - bookmark.dispose() + bookmark = bookmarks.getByName(bookmarks.ElementNames(0)) + bookmark.dispose() Wend End Sub Private Sub removeManualPageBreaks + Dim oTextCursor As Object + Dim enum1 As Object + Dim enum1Element As Object oTextCursor = ThisComponent.Text.CreateTextCursor() enum1 = ThisComponent.Text.createEnumeration While enum1.hasMoreElements @@ -538,12 +544,15 @@ Sub setAttributesBySearchPattern(searchPattern As String,ReplAttributes, Optiona doNotTrack dim stringValue1 As String dim stringValue2 As String - Dim oSearch + Dim oSearch As Object Dim oTextCursor As Object Dim oViewCursor As Object Dim replace As Boolean Dim attrName As string Dim attrValue As String + Dim oFound As Object + Dim i As Long + Dim j As Long dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") oSearch = ThisComponent.createSearchDescriptor() oSearch.SearchString = searchPattern @@ -585,9 +594,8 @@ Sub setAttributesBySearchPattern(searchPattern As String,ReplAttributes, Optiona End Sub Private Sub saveAndreload() - - dim document as object - dim dispatcher as object + Dim document As Object + Dim dispatcher As Object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dispatcher.executeDispatch(document, ".uno:Save", "", 0, Array()) @@ -596,9 +604,8 @@ Private Sub saveAndreload() End Sub Private Sub saveDocument() - - dim document as object - dim dispatcher as object + Dim document As Object + Dim dispatcher As Object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dispatcher.executeDispatch(document, ".uno:Save", "", 0, Array()) @@ -616,20 +623,16 @@ Private Sub cleanFormatting 'Не должно быть пустых абзацев AskAndReplace("^$","") - convertFormattingToText + convertFormattingToText() - convertFontsToCharStyles + convertFontsToCharStyles() - replaceBaseWithStandard + replaceBaseWithStandard() - removeDirectFormatting + removeDirectFormatting() - convertFormattingFromText + convertFormattingFromText() - - - - End Sub Private Sub fixTableWidth() @@ -637,6 +640,7 @@ Private Sub fixTableWidth() Dim tables As Object tables = ThisComponent.TextTables Dim count As Long + Dim i As Long count = ThisComponent.TextTables.getCount() For i = 0 To count - 1 table = tables.getByIndex(i) @@ -654,6 +658,7 @@ Private Sub fixDrawingAnchors() Dim drawings As Object drawings = ThisComponent.DrawPage Dim count As Long + Dim i As Long count = drawings.getCount() For i = 0 To count - 1 drawing = drawings.getByIndex(i) diff --git a/Redaction/Configuration.xba b/Redaction/Configuration.xba index 73f75fb..f7664a3 100644 --- a/Redaction/Configuration.xba +++ b/Redaction/Configuration.xba @@ -6,6 +6,7 @@ Function initRedactionConfiguration() On Error Goto exceptionHandler Dim regFactory As Object Dim reg As Object + Dim redactionProps As Object Dim props(2) As New com.sun.star.beans.PropertyValue regFactory = CreateUnoService("com.sun.star.ucb.Store") @@ -19,7 +20,7 @@ Function initRedactionConfiguration() initRedactionConfiguration = redactionProps End Function -Private Sub setConfigFromDialog(dialog) +Private Sub setConfigFromDialog(dialog As Object) Dim config As Object config = initRedactionConfiguration() If dialog.getControl("CB_complexity").state = 1 Then @@ -29,7 +30,7 @@ Private Sub setConfigFromDialog(dialog) EndIf End Sub -Private Sub loadConfigToDialog(dialog) +Private Sub loadConfigToDialog(dialog As Object) Dim config As Object config = initRedactionConfiguration() If config.getPropertyValue("complexity") = "makerUp" Then @@ -51,11 +52,8 @@ Private Sub configurationDialog setConfigFromDialog(dialog) Case 0 End Select - dialog.setVisible(false) dialog.dispose() Exit sub - - End Sub \ No newline at end of file diff --git a/Redaction/Validation.xba b/Redaction/Validation.xba index 6830f4f..74121e9 100644 --- a/Redaction/Validation.xba +++ b/Redaction/Validation.xba @@ -4,7 +4,7 @@ End Sub -Private Function isInDoc(searchString As String) +Private Function isInDoc(searchString As String) As Boolean Dim founds As Object Dim sDesc As Object Dim srch(0) as new com.sun.star.beans.PropertyValue @@ -71,12 +71,7 @@ Sub validateButton EndIf End Sub - -Sub testcheckGraphics - checkGraphics -End Sub - -Private Function checkGraphics +Private Function checkGraphics() As String Dim drawPages As Object Dim count as Integer Dim draw As Object @@ -127,13 +122,12 @@ End Function Private Sub removeBadCharacters StartTracking - AskAndReplace("[\uE000-\uF8FF]+","") - + AskAndReplace("[\uE000-\uF8FF]+","") StopTracking showTrackedChanges End Sub -Private Function checkAllFootnotes() +Private Function checkAllFootnotes() As String Dim footnotes As Object Dim count as Integer Dim charNum as Long diff --git a/description.xml b/description.xml index c9855ef..1802777 100644 --- a/description.xml +++ b/description.xml @@ -3,7 +3,7 @@ xmlns:dep="http://openoffice.org/extensions/description/2006" xmlns:xlink="http://www.w3.org/1999/xlink"> - + Cleaning and validation documents for publishing in html and epub with pagination