Sub markZXZ End Sub Private Function isInDoc(searchString As String) Dim founds As Object Dim sDesc As Object Dim srch(0) as new com.sun.star.beans.PropertyValue sDesc = Thiscomponent.createSearchDescriptor() sDesc.SearchAll = true sDesc.ValueSearch = false sDesc.SearchStyles = false sDesc.SearchRegularExpression = true sDesc.SearchString = searchString founds = Thiscomponent.findAll(sDesc) If founds.count <> 0 Then isInDoc = true Else isInDoc = false EndIf End Function Sub validateButton Dim footnotesReport As String Dim graphicsReport As String Dim badText As Boolean Dim badNumberings As Boolean Dim badFootnoteSigns As Boolean Dim badGraphics As Boolean Dim needExtendedInfo As Boolean badGraphics = false badText = false badFootnoteSigns = false badNumberings = false footnotesReport = checkAllFootnotes graphicsReport = checkGraphics If footnotesReport <> "" Then badFootnoteSigns = true EndIf If graphicsReport <> "" Then badGraphics = true EndIf If isInDoc("[\uE000-\uF8FF]") Then badText = true EndIf If badFootnoteSigns Then MsgBox footnotesReport EndIf If badGraphics Then MsgBox graphicsReport EndIf Dim config As Object config = initRedactionConfiguration() If config.getPropertyValue("complexity") = "makerUp" then needExtendedInfo = true Else needExtendedInfo = false EndIf printNumberingSymbols(needExtendedInfo) If badText OR badNumberings OR badFootnoteSigns OR badGraphics Then MsgBox "Перед публикацией документа следует исправить все найденные замечания." If badText Then MsgBox "В тексте обнаружены неподходящие для публикции символы." & chr(10) & " Далее будет представлен список отрывков текста с подобными символами." removeBadCharacters EndIf Else MsgBox "Документ успешно прошел проверку. " & chr(10) & "Все изображения и символы корректны." EndIf End Sub Sub testcheckGraphics checkGraphics End Sub Private Function checkGraphics Dim drawPages As Object Dim count as Integer Dim draw As Object Dim result As String result = "" Dim shapeType As String Dim embeededObject As Object Dim badFrame As Long badFrame = 0 Dim drawingN As Long drawingN = 0 drawPages = ThisComponent.DrawPage ' Globalscope.BasicLibraries.LoadLibrary( "MRILib" ) ' MRI ThisComponent count = drawPages.getCount() For i = 0 to count-1 draw = drawPages.getByIndex(i) shapeType = draw.ShapeType If InStr(shapeType,"com.sun.star.drawing") = 1 Then drawingN = drawingN + 1 EndIf If InStr(shapeType,"FrameShape") = 1 Then ' Globalscope.BasicLibraries.LoadLibrary( "MRILib" ) ' MRI draw If draw.supportsService("com.sun.star.text.TextEmbeddedObject") Then embeededObject = draw.getEmbeddedObject() If IsNull(embeededObject) Then badFrame = badFrame + 1 Else If Not embeededObject.supportsService("com.sun.star.formula.FormulaProperties") Then badFrame = badFrame + 1 Else 'Formula EndIf EndIf EndIf EndIf Next i If drawingN <> 0 Then result = result &"В документе найдены рисунки (" & drawingN & "), неподходящие для публикации." & chr(10) EndIf If badFrame <> 0 Then result = result &"В документе найдены встроенные объекты (" & badFrame & "), неподходящие для публикации." & chr(10) EndIf checkGraphics = result End Function Private Sub removeBadCharacters StartTracking AskAndReplace("[\uE000-\uF8FF]+","") StopTracking showTrackedChanges End Sub Private Function 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) End If Next j Next i checkAllFootnotes = result End Function Private Sub printNumberingSymbols(needExtendedInfo) Dim families As Object Dim numStyles As Object Dim numStyle As Object Dim numRules As Object Dim numRule As Object Dim prop As Object Dim enum1 As Object Dim enum1Element As Object Dim fontProp As Object Dim fontName As String Dim result As String Dim resultBad As String dim excerpt As String dim exLength As Integer families = ThisComponent.StyleFamilies numStyles = families.getByName("NumberingStyles") result = "" resultBad = "" enum1 = ThisComponent.Text.createEnumeration Do While enum1.hasMoreElements enum1Element = enum1.nextElement If enum1Element.supportsService("com.sun.star.text.Paragraph") Then If NOT IsMissing(enum1Element.NumberingRules) AND NOT IsEmpty(enum1Element.NumberingRules) Then numRules = enum1Element.NumberingRules If numRules.hasElements Then numRule = numRules.getByIndex(enum1Element.NumberingLevel) fontName = "" fontChar = "" For k = 0 To Ubound(numRule) prop = numRule(k) If prop.Name = "BulletFont" Then fontName = prop.Value.Name EndIf If prop.Name = "BulletChar" Then fontChar = prop.Value EndIf Next k exLength = 15 excerpt = enum1Element.String If Len(excerpt) < exLength Then exLength = Len(excerpt) EndIf tmp = "Уровень " & (j + 1) & " шрифт " & fontName & " символ " & fontChar & " (" & Hex(Asc(fontChar)) & ") "& Left(excerpt,exLength) & chr(10) If Asc(fontChar) > 57344 AND Asc(fontChar) < 63743 Then resultBad = resultBad & tmp ElseIf fontName <> "IPH Astra Serif" _ AND fontName <> "OpenSymbol" _ AND fontName <> "IPH Lib Serif" _ AND fontName <> "IPH Lib Sans" _ AND fontName <> "Liberation Serif" _ AND fontName <> "Liberation Sans" _ AND needExtendedInfo Then result = result & tmp EndIf EndIf EndIf EndIf Loop dim report as String report = "" If result = "" AND resultBad = "" Then Exit sub Else If resultBad <> "" Then report = "Маркером в следующих списках нумерации задан некорректный символ"& chr(10) & resultBad EndIf If result <> "" Then report = report & "В следующих списках нумерации найдены шрифты "& chr(10)& result EndIf EndIf MsgBox report End Sub Private 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 Private 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 Private 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