Sub markval5 End Sub 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 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 outlineInNotesReport As String Dim badText As Boolean Dim badNumberings As Boolean Dim needExtendedInfo As Boolean Dim config As Object config = initRedactionConfiguration() badText = false badNumberings = false footnotesReport = noteSingsCheck graphicsReport = checkGraphics outlineInNotesReport = checkNotesOutline() If outlineInNotesReport <> "" Then MsgBox outlineInNotesReport EndIf If footnotesReport <> "" Then MsgBox footnotesReport EndIf If graphicsReport <> "" Then MsgBox graphicsReport EndIf If isInDoc("[\uE000-\uF8FF]") Then badText = true EndIf If config.getPropertyValue("complexity") = "makerUp" then needExtendedInfo = true Else needExtendedInfo = false EndIf printNumberingSymbols(needExtendedInfo) If badText OR badNumberings OR footnotesReport <> "" OR graphicsReport <> "" Or outlineInNotesReport <> "" Then MsgBox getTranslation("validationWarning") If badText Then MsgBox getTranslation("validationBadSymbolsNotification") removeBadCharacters EndIf Else MsgBox getTranslation("validationSuccess") EndIf End Sub Private Function checkGraphics() As String 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 Dim i As Integer 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 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 & getTranslation("validationBadDrawings") & drawingN & getTranslation("validationExcerptNotSuitable") & chr(10) EndIf If badFrame <> 0 Then result = result & getTranslation("validationBadEmbeededObjects") & badFrame & getTranslation("validationExcerptNotSuitable") & chr(10) EndIf checkGraphics = result End Function Private Sub removeBadCharacters StartTracking AskAndReplace("[\uE000-\uF8FF]+","") StopTracking showTrackedChanges End Sub Private Function noteSingsCheck() As String Dim footnotes As Object Dim footnote As Object Dim endnote As Object Dim endnotes 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 endnotes = ThisComponent.Footnotes count = footnotes.getCount Dim i As Integer Dim j As Integer For i = 0 to count-1 footnote = footnotes.getByIndex(i) 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 & getTranslation("validateFootnotes1") & " " & Chr(char) & " " & getTranslation("validateFootnotes2") & " " & i & " " & getTranslation("validateFootnotes3") & chr(10) End If Next j Next i count = endnotes.getCount For i = 0 to count-1 endnote = endnotes.getByIndex(i) label = endnote.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 & getTranslation("validateFootnotes1") & " " & Chr(char) & " " & getTranslation("validateEndnotes1") & " " & i & " " & getTranslation("validateFootnotes3") & chr(10) End If Next j Next i noteSingsCheck = result End Function Function checkNotesOutline As String Dim oDescriptor As Object Dim footNotes As Object Dim x As Integer Dim aNote As Object Dim oEnum As Object Dim oCurPar As Object Dim result As String result = "" footNotes = thisComponent.footNotes endNotes = thisComponent.EndNotes for x = 0 to footNotes.Count -1 aNote = footNotes.getByIndex(x) aNote.Anchor.CharStyleName="Footnote anchor" oEnum = aNote.Text.createEnumeration() Do While oEnum.hasMoreElements() oCurPar = oEnum.nextElement() If oCurPar.OutlineLevel > 0 Then result = result & getTranslation("validateFootnotes2") & " " & x & " " & getTranslation("setOutlineLevel") & " " & oCurPar.OutlineLevel & chr(10) EndIf Loop Next for x = 0 to endNotes.Count -1 aNote = endNotes.getByIndex(x) aNote.Anchor.CharStyleName="Footnote anchor" oEnum = aNote.Text.createEnumeration() Do While oEnum.hasMoreElements() oCurPar = oEnum.nextElement() If oCurPar.OutlineLevel > 0 Then result = result & getTranslation("validateEndnotes1") & " " & x & " " & getTranslation("setOutlineLevel") & " " & oCurPar.OutlineLevel & chr(10) EndIf Loop Next checkNotesOutline = 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 Dim report As String Dim k 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 If fontChar <> "" Then tmp = getTranslation("validateNumberingLevel") &" " & (j + 1) & " " & getTranslation("validateNumberingFont") & " " & fontName & " " & getTranslation("validateNumberingSymbol") & " " & 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 EndIf Loop report = "" If result = "" AND resultBad = "" Then Exit sub Else If resultBad <> "" Then report = getTranslation("validateNumberingsReportSymbols") & chr(10) & resultBad EndIf If result <> "" Then report = report & getTranslation("validateNumberingsReportFonts") & " "& 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 Dim dispatcher As Object Dim document As Object 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 Dim dispatcher As Object Dim document As Object 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