Sub fixFrequentMistakes Dim description As String description = "Вы уверены, что хотите запустить исправление часто встречающихся ошибок?" If NOT confirm(description) Then Exit Sub EndIf saveDocument() saveVersion("Перед выполнением макроса Ошибки") StopTracking Dim statusIndicator as Object Dim NBSP As String Dim space As String NBSP = " " space = " " statusIndicator = ThisComponent.getCurrentController.statusIndicator statusIndicator.Start("Исправление ошибок начато, подождите",30) 'Не должно быть символов табуляции AskAndReplace("\t","") 'Не должно быть подряд больше одного пробела AskAndReplace("(?<=[:space:])[:space:]+","") 'Не должно быть ни одного пробела в начале абзацев AskAndReplace("^[:space:]+","") 'Не должно быть пробелов в конце абзацев AskAndReplace("[:space:]+$","") 'Не должно быть пустых абзацев AskAndReplace("^$","") 'Не должно быть пробелов перед знаками пунктуации .,;:?!)]}»¡¿”‘’ AskAndReplace("[:space:]+(?=[\.,;:?!\)\]\}»¡¿”‘’])","") 'Между словом том и цифрой должен быть неразрывный пробел, а не обычный AskAndReplace("(?<=\b[тТ](ом|\.))\ (?=[:digit:])",NBSP) 'Между словом серия и цифрой должен быть неразрывный пробел, а не обычный AskAndReplace("(?<=\b[сС](ерия|\.))\ +(?=[:digit:])",NBSP) 'Между словом часть и цифрой должен быть неразрывный пробел, а не обычный AskAndReplace("(?<=\b[чЧ](асть|\.))\ +(?=[:digit:])",NBSP) 'Между числом и "г." должен быть неразрывный пробел, а не обычный AskAndReplace("(?<=[0-9])[:space:]*г(?=\.)",NBSP & "г") 'Между инициалами и Фамилией должен быть неразрывный пробел, а не обычный AskAndReplace("(?<=[:upper:]\.[:space:][:upper:]\.)\ (?=[:upper:][:lower:]+)",NBSP) 'Между Фамилией и инициалами должен быть неразрывный пробел, а не обычный AskAndReplace("(?<=[:upper:][:lower:]{1,30})\ (?=[:upper:]\.[:space:][:upper:]\.)",NBSP) 'Не должно быть пробелов после скобок [({ и кавычек «„ AskAndReplace("(?<=[\(\[\{«„])[:space:]","") 'Между "и" и "т." должен быть неразрывный пробел, а не обычный AskAndReplace("(?<=\bи)\ (?=т\.)",NBSP) 'Между "т." и "е./н./д./п./к." должен быть неразрывный пробел, а не обычный AskAndReplace("(?<=\bт)\.\ ?(?=[ендпк]\.)","." & NBSP) 'Между буквами среднее тире должно обрамляться пробелами AskAndReplace("(?<=[:alpha:])–(?=[:alpha:])",NBSP & "–" & NBSP) 'Между буквами дефис-минус, цифровое тире и длинное тире заменяется на среднее тире AskAndReplace("(?<=[:alpha:][:space:])[-‒—](?=[:space:][:alpha:])","–") 'Между двумя цифрами и тире между ними не долнжо быть пробелов. А также тире должно быть цифровым AskAndReplace("(?<=[:digit:])(?:[:space:])?[-‒–—](?:[:space:])?(?=[:digit:])","‒") 'Между двумя римскими цифрами и тире между ними не долнжо быть пробелов. А также тире должно быть средним AskAndReplace("(?<=[MDCLXVI])(?:[:space:])?[-‒–—](?:[:space:])?(?=[MDCLXVI])","–") 'Между буквой и угловой открывающейся скобкой должен быть пробел AskAndReplace("(?<=[:alpha:])<(?=…>)",space & "<") 'Между угловой закрывающейся скобкой и буквой должен быть пробел AskAndReplace("(?<=<…)>(?=[:alpha:])",">" & space) statusIndicator.end() saveAndreload() End Sub Sub workaroundForDiacriticKerningBug AskAndReplace("([:print:][\u0300-\u036F])","$1") End Sub Sub validateButton MsgBox "Validation works!" End Sub Sub executeCitationCorrection StartTracking AskAndReplace("(?<=[:alpha:])<(?=…>)"," <") AskAndReplace("(?<=<…)>(?=[:alpha:])","> ") AskAndReplace("(?<=[:alpha:])–(?=[:alpha:])"," – ") StopTracking End Sub Sub executeRemoveConsequentSpaces StartTracking AskAndReplace("(?<=[:space:])[:space:]+","") StopTracking End Sub Sub removeBadCharacters StartTracking AskAndReplace("[\uE000-\uF8FF]+","") checkAllFootnotes StopTracking showTrackedChanges End Sub Sub executeRemoveSpacesBeforeStops StartTracking AskAndReplace("[:space:]+(?=[\.,;:?!\)\]\}»¡¿”‘’])","") 'removed “ StopTracking End Sub Sub executeNumericDashBetweenNumbers StartTracking AskAndReplace("(?<=[:digit:])(?:[:space:])?[-‒–—](?:[:space:])?(?=[:digit:])","‒") StopTracking End Sub Sub executeReplaceLongDashWithSpacesBetweenWords StartTracking AskAndReplace("(?<=[:alpha:][:space:])[-‒—](?=[:space:][:alpha:])","–") StopTracking End Sub Sub executeRemoveSpacesAfterOpenedQuoteOrBracket StartTracking AskAndReplace("(?<=[\(\[\{«„])[:space:]","") StopTracking End Sub Sub executeNonBreakingSpaceBetweenLastnameAndInitials StartTracking AskAndReplace("(?<=[^.!?][:space:][:upper:][:lower:]{1,30})\ (?=[:upper:]\.[:upper:]\.)"," ") StopTracking End Sub Sub executeNonBreakingSpaceBetweenInitialsAndLastName StartTracking AskAndReplace("(?<=[:upper:]\.[:upper:]\.)\ (?=[:upper:][:lower:]+)"," ") StopTracking End Sub Sub executeNonBreakingSpaceBetweenEtc StartTracking AskAndReplace("(?<=\bи)\ (?=т\.)"," ") AskAndReplace("(?<=\bт)\.\ ?(?=[ендпк]\.)",". ") StopTracking End Sub 'Sub executeNonBreakingSpaceAfterPageOrVolume ' StartTracking ' AskAndReplace("(?<=\b[сСтТ]\.)[:space:](?=[:digit:])"," ") ' StopTracking 'End Sub Sub executeNonBreakingSpaceBetweenVol StartTracking AskAndReplace("(?<=\b[тТ](ом|\.))[:space:](?=[:digit:])"," ") StopTracking End Sub Sub executeNonBreakingSpaceBetweenSeries StartTracking AskAndReplace("(?<=\b[сС](ерия|\.))[:space:](?=[:digit:])"," ") StopTracking End Sub Sub executeNonBreakingSpaceBetweenPart StartTracking AskAndReplace("(?<=\b[чЧ](асть|\.))[:space:]+(?=[:digit:])"," ") StopTracking End Sub Sub executeNonBreakingSpaceBetweenYear StartTracking AskAndReplace("(?<=[0-9])[:space:]*г(?=\.)"," г") StopTracking End Sub Sub StartTracking dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") document = ThisComponent.CurrentController.Frame dim trackProperties(0) as new com.sun.star.beans.PropertyValue trackProperties(0).Name = "TrackChanges" trackProperties(0).Value = true dispatcher.executeDispatch(document, ".uno:TrackChanges", "", 0, trackProperties()) dim args1(0) as new com.sun.star.beans.PropertyValue args1(0).Name = "ShowTrackedChanges" args1(0).Value = true dispatcher.executeDispatch(document, ".uno:ShowTrackedChanges", "", 0, args1()) End Sub Sub StopTracking dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") document = ThisComponent.CurrentController.Frame dim trackProperties(0) as new com.sun.star.beans.PropertyValue trackProperties(0).Name = "TrackChanges" trackProperties(0).Value = false dispatcher.executeDispatch(document, ".uno:TrackChanges", "", 0, trackProperties()) dim args1(0) as new com.sun.star.beans.PropertyValue args1(0).Name = "ShowTrackedChanges" args1(0).Value = true dispatcher.executeDispatch(document, ".uno:ShowTrackedChanges", "", 0, args1()) End Sub Sub executeRemoveWhiteBackground Dim description As String Dim searchPattern As String searchPattern = "" description = "Вы уверены, что хотите заменить белый фон на прозрачный в текущем документе?" If NOT confirm(description) Then Exit Sub EndIf Dim statusIndicator as Object statusIndicator = ThisComponent.getCurrentController.statusIndicator statusIndicator.Start("Замена белого фона на прозрачный начата",100) Dim SrchAttributes(1) as new com.sun.star.beans.PropertyValue Dim ReplAttributes(1) as new com.sun.star.beans.PropertyValue SrchAttributes(0).Name = "CharBackTransparent" SrchAttributes(0).Value = False SrchAttributes(1).Name = "CharBackColor" SrchAttributes(1).Value = 16777215 ReplAttributes(0).Name = "CharBackTransparent" ReplAttributes(0).Value = True ReplAttributes(1).Name = "CharBackColor" ReplAttributes(1).Value = -1 setAttributesBySearchPattern(searchPattern,SrchAttributes,ReplAttributes) statusIndicator.end() End Sub Sub ReplaceEverywhere(SearchString,oReplaceString) Dim oDoc,oText,oViewCursor,oStart,oEnd,oFind,FandR As Object oDoc = ThisComponent oText = oDoc.Text Footnotes = oDoc.Footnotes oViewCursor = oDoc.CurrentController.getViewCursor oStart = oViewCursor.Text.createTextCursorByRange(oViewCursor.Start) FandR = oDoc.createReplaceDescriptor With FandR .SearchString = SearchString .ReplaceString = oReplaceString .SearchRegularExpression=True .searchAll=True End With If Not oViewCursor.isCollapsed then oEnd = oViewCursor.Text.createTextCursorByRange(oViewCursor.End) End If If isEmpty(oEnd) then 'Do whole document. oDoc.replaceAll(FandR) Else 'Do selection. Do oFind = oDoc.FindNext(oStart.End,FandR) If isNull(oFind) then Exit Do End If If oViewCursor.Text.compareRegionEnds(oFind,oEnd) < 0 then Exit Do End If oFind.setString(FandR.ReplaceString) oFind = oDoc.FindNext(oFind.End,FandR) Loop EndIf End Sub Function IsAnythingSelected(oDoc As Object) As Boolean Dim oSelections 'Contains all of the selections Dim oSel 'Contains one specific selection Dim oCursor 'Text cursor to check for a collapsed range REM Assume nothing is selected IsAnythingSelected = False If IsNull(ThisComponent) Then Exit Function End If ' The current selection in the current controller. 'If there is no current controller, it returns NULL. oSelections = ThisComponent.getCurrentSelection() If IsNull(oSelections) Then Exit Function End If If oSelections.getCount() = 0 Then Exit Function End If If oSelections.getCount() > 1 Then REM There is more than one selection so return True IsAnythingSelected = True Exit Function End If REM There is only one selection so obtain the first selection oSel = oSelections.getByIndex(0) lenght = Len(oSel.String) If lenght > 0 Then IsAnythingSelected = True End If End Function Sub AskAndReplace(SearchString, oReplaceString) Dim SrchAttributes(0) as new com.sun.star.beans.PropertyValue Dim ReplAttributes(0) as new com.sun.star.beans.PropertyValue If IsAnythingSelected() Then oSelections = ThisComponent.getCurrentSelection() ReplaceInSelection(SearchString, oReplaceString) thisComponent.currentController.select(oSelections) Else ReplaceFormatting(SearchString,oReplaceString,SrchAttributes,ReplAttributes, true) ' ReplaceEverywhere(SearchString, oReplaceString) End If End Sub Sub ReplaceInSelection(SearchString,oReplaceString) rem ---------------------------------------------------------------------- rem define variables dim document as object dim dispatcher as object rem ---------------------------------------------------------------------- rem get access to the document document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") rem ---------------------------------------------------------------------- dim args1(21) as new com.sun.star.beans.PropertyValue args1(0).Name = "SearchItem.StyleFamily" args1(0).Value = 2 args1(1).Name = "SearchItem.CellType" args1(1).Value = 0 args1(2).Name = "SearchItem.RowDirection" args1(2).Value = true args1(3).Name = "SearchItem.AllTables" args1(3).Value = false args1(4).Name = "SearchItem.SearchFiltered" args1(4).Value = false args1(5).Name = "SearchItem.Backward" args1(5).Value = false args1(6).Name = "SearchItem.Pattern" args1(6).Value = false args1(7).Name = "SearchItem.Content" args1(7).Value = false args1(8).Name = "SearchItem.AsianOptions" args1(8).Value = false args1(9).Name = "SearchItem.AlgorithmType" args1(9).Value = 1 args1(10).Name = "SearchItem.SearchFlags" args1(10).Value = 71680 args1(11).Name = "SearchItem.SearchString" args1(11).Value = SearchString args1(12).Name = "SearchItem.ReplaceString" args1(12).Value = oReplaceString args1(13).Name = "SearchItem.Locale" args1(13).Value = 255 args1(14).Name = "SearchItem.ChangedChars" args1(14).Value = 2 args1(15).Name = "SearchItem.DeletedChars" args1(15).Value = 2 args1(16).Name = "SearchItem.InsertedChars" args1(16).Value = 2 args1(17).Name = "SearchItem.TransliterateFlags" args1(17).Value = 1024 args1(18).Name = "SearchItem.Command" args1(18).Value = 3 args1(19).Name = "SearchItem.SearchFormatted" args1(19).Value = false args1(20).Name = "SearchItem.AlgorithmType2" args1(20).Value = 2 args1(21).Name = "Quiet" args1(21).Value = true dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "", 0, args1()) end Sub sub insertSpecialCharacterInFont(sCharacter As String, sFont As String) rem ---------------------------------------------------------------------- rem define variables dim document as object dim dispatcher as object rem ---------------------------------------------------------------------- rem get access to the document document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") rem ---------------------------------------------------------------------- dim args1(1) as new com.sun.star.beans.PropertyValue args1(0).Name = "Symbols" args1(0).Value = sCharacter args1(1).Name = "FontName" args1(1).Value = sFont dispatcher.executeDispatch(document, ".uno:InsertSymbol", "", 0, args1()) end Sub Sub searchAndRemoveDirectFormatting(searchString) oViewCursor = thisComponent.getCurrentController.getViewCursor oViewCursor.jumpToFirstPage oSearch = ThisComponent.createSearchDescriptor() oSearch.SearchString = searchString oSearch.SearchRegularExpression=True oSearch.searchAll=True oFound = ThisComponent.findFirst(oSearch) Do While Not IsNull(oFound) oTextCursor = oFound.Text.createTextCursor() oFound.setString(oFound.getString) oFound = ThisComponent.findNext(oFound.End, oSearch) Loop End Sub sub RemoveStyleByName(styleName As String) Dim oDoc as Object Dim propertySetInfo As Object oDoc = ThisComponent oFamilies = thiscomponent.StyleFamilies sElements() = oFamilies.getElementNames() For i = 0 to oFamilies.count -1 oFamily = oFamilies.getByName(sElements(i)) For j = 0 to oFamily.getCount -1 oStyle = oFamily.getByIndex(j) If oStyle.Name = styleName Then oFamily.removeByName(oStyle.Name) Exit For EndIf Next Next End Sub sub showTrackedChanges dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dispatcher.executeDispatch(document, ".uno:AcceptTrackedChanges", "", 0, Array()) dim args2(0) as new com.sun.star.beans.PropertyValue args2(0).Name = "ShowTrackedChanges" args2(0).Value = true dispatcher.executeDispatch(document, ".uno:ShowTrackedChanges", "", 0, args2()) end sub Sub checkAllFootnotes() Dim footnotes As Object Dim count as Integer Dim charNum as Long Dim char As Long Dim label As String Dim result As String result = "" footnotes = ThisComponent.Footnotes count = footnotes.getCount For i = 0 to count-1 footnote = footnotes.getByIndex(i) ' Mri footnote label = footnote.Label charNum = Len(label) For j = 1 to charNum char = Asc(Right(Left(label,j),1)) If char >= 57344 AND char <= 63743 then result = result & "Символ "& Chr(char) &" сноски "& i &" находится в диапазоне для частного использования"& chr(10) 'Mri footnote 'footNote.setLabel(Left(label,j-1) & "*" & Right(label,charNum-j)) End If Next j Next i If result <> "" then MsgBox result EndIf End Sub