Sub markval10 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 sectionsReport As String Dim outlinePageStylesReport As String Dim outlineInNotesReport As String Dim oulineInTablesReport As String Dim badText As Boolean Dim badNumberings As Boolean Dim needExtendedInfo As Boolean Dim config As Object config = initRedactionConfiguration() Dim statusIndicator as Object statusIndicator = ThisComponent.getCurrentController.statusIndicator statusIndicator.Start(getTranslation("validationStarted"),100) badText = false badNumberings = false footnotesReport = noteSingsCheck statusIndicator.setValue(10) graphicsReport = checkGraphics statusIndicator.setValue(20) sectionsReport = checkSectionsInTables statusIndicator.setValue(30) outlineInNotesReport = checkNotesOutline() statusIndicator.setValue(40) outlinePageStylesReport = checkHeadingsInHeadersFooters statusIndicator.setValue(50) oulineInTablesReport = checkHeadingsInTextTables statusIndicator.setValue(60) If outlineInNotesReport <> "" Then MsgBox outlineInNotesReport EndIf If oulineInTablesReport <> "" Then MsgBox oulineInTablesReport EndIf If outlinePageStylesReport <> "" Then MsgBox outlinePageStylesReport EndIf If footnotesReport <> "" Then MsgBox footnotesReport EndIf If graphicsReport <> "" Then MsgBox graphicsReport EndIf If sectionsReport <> "" Then MsgBox sectionsReport EndIf If isInDoc("[\uE000-\uF8FF]") Then badText = true EndIf If config.getPropertyValue("complexity") = "makerUp" then needExtendedInfo = true Else needExtendedInfo = false EndIf printNumberingSymbols(needExtendedInfo) statusIndicator.setValue(80) If badText OR badNumberings OR footnotesReport <> "" OR graphicsReport <> "" Or outlineInNotesReport <> "" Or sectionsReport <> "" OR oulineInTablesReport <> "" OR outlinePageStylesReport <> "" Then MsgBox getTranslation("validationWarning") If badText Then MsgBox getTranslation("validationBadSymbolsNotification") removeBadCharacters EndIf Else MsgBox getTranslation("validationSuccess") EndIf statusIndicator.end() 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 endNotes 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 Function checkSectionsInTables As String Dim x As Integer Dim oEnum As Object Dim result As String Dim sections As Object Dim section As Object Dim anchor As Object Dim anchorText As Object result = "" sections = thisComponent.TextSections for x = 0 to sections.Count -1 section = sections.getByIndex(x) anchor = section.getAnchor() anchorText = anchor.getText() If anchorText.supportsService("com.sun.star.text.CellProperties") Then result = result & getTranslation("section") & " " & section.Name & " " & getTranslation("isInTable") & chr(10) EndIf Next checkSectionsInTables = result End Function Function checkHeadingsInHeadersFooters As String Dim result As String Dim count As Integer Dim oStyle As Object Dim i As Integer result = "" Dim pageStyles As Object pageStyles = ThisComponent.StyleFamilies.getByName("PageStyles") count = pageStyles.count - 1 For i = 0 to count oStyle = pageStyles.getByIndex(i) If oStyle.isInUse Then If oStyle.HeaderIsOn Then If oStyle.HeaderIsShared Then If isHeadingsInText(oStyle.HeaderText) Then result = result & getTranslation("foundHeadingIn") & " " & getTranslation("inHeader") & " " & getTranslation("inPageStyle") & " " & oStyle.getName() & chr(10) EndIf Else If isHeadingsInText(oStyle.HeaderTextLeft) Then result = result & getTranslation("foundHeadingIn") & " " & getTranslation("inHeader") & " " & getTranslation("inPageStyle") & " " & oStyle.getName() & chr(10) EndIf If isHeadingsInText(oStyle.HeaderTextRight) Then result = result & getTranslation("foundHeadingIn") & " " & getTranslation("inHeader") & " " & getTranslation("inPageStyle") & " " & oStyle.getName() & chr(10) EndIf EndIf If NOT oStyle.FirstIsShared Then If isHeadingsInText(oStyle.HeaderTextFirst) Then result = result & getTranslation("foundHeadingIn") & " " & getTranslation("inHeader") & " " & getTranslation("inPageStyle") & " " & oStyle.getName() & chr(10) EndIf EndIf EndIf If oStyle.FooterIsOn Then If oStyle.FooterIsShared Then If isHeadingsInText(oStyle.FooterText) Then result = result & getTranslation("foundHeadingIn") & " " & getTranslation("inFooter") & " " & getTranslation("inPageStyle") & " " & oStyle.getName() & chr(10) EndIf Else If isHeadingsInText(oStyle.FooterTextLeft) Then result = result & getTranslation("foundHeadingIn") & " " & getTranslation("inFooter") & " " & getTranslation("inPageStyle") & " " & oStyle.getName() & chr(10) EndIf If isHeadingsInText(oStyle.FooterTextRight) Then result = result & getTranslation("foundHeadingIn") & " " & getTranslation("inFooter") & " " & getTranslation("inPageStyle") & " " & oStyle.getName() & chr(10) EndIf EndIf If NOT oStyle.FirstIsShared Then If isHeadingsInText(oStyle.FooterTextFirst) Then result = result & getTranslation("foundHeadingIn") & " " & getTranslation("inFooter") & " " & getTranslation("inPageStyle") & " " & oStyle.getName() & chr(10) EndIf EndIf EndIf EndIf Next i checkHeadingsInHeadersFooters = result End Function Function checkHeadingsInTextTables(oText As Object) As String Dim enum1Element As Object Dim enum1 As Object Dim enum2 As Object Dim thisPortion As Object Dim footnoteText As Object Dim label As String Dim labelNum As Integer Dim i As Integer Dim count As Integer Dim cell As Object Dim cellText As Object Dim firstCellName As String Dim result As String result = "" enum1 = ThisComponent.Text.createEnumeration While enum1.hasMoreElements enum1Element = enum1.nextElement If enum1Element.supportsService("com.sun.star.text.TextTable") Then firstCellName = enum1Element.getCellByPosition(0,0).cellName cellNames = enum1Element.cellNames For i = LBound(cellNames) To Ubound(cellNames) cell = enum1Element.getCellByName(cellNames(i)) cellText = cell.getText() If cellNames(i) = firstCellName Then If isHeadingNotFirstInText(cellText) Then result = result & getTranslation("foundHeadingIn") & " " & getTranslation("table") & " " & enum1Element.TableName & chr(10) EndIf Else If isHeadingsInText(cellText) Then result = result & getTranslation("foundHeadingIn") & " " & getTranslation("table") & " " & enum1Element.TableName & chr(10) EndIf EndIf Next i EndIf Wend checkHeadingsInTextTables = result End Function Function isHeadingNotFirstInText(oText As Object) As Boolean Dim enum1Element As Object Dim enum1 As Object Dim enum2 As Object Dim thisPortion As Object Dim footnoteText As Object Dim label As String Dim labelNum As Integer Dim i As Integer Dim count As Integer Dim cell As Object Dim cellText As Object Dim first As Boolean first = true enum1 = oText.createEnumeration While enum1.hasMoreElements enum1Element = enum1.nextElement If enum1Element.supportsService("com.sun.star.text.Paragraph") Then If Not first Then If enum1Element.OutlineLevel > 0 Then isHeadingNotFirstInText = true Exit Function EndIf EndIf ElseIf enum1Element.supportsService("com.sun.star.text.TextTable") Then cellNames = enum1Element.cellNames For i = LBound(cellNames) To Ubound(cellNames) cell = enum1Element.getCellByName(cellNames(i)) cellText = cell.getText() If isHeadingsInText(cellText) Then isHeadingNotFirstInText = true Exit Function EndIf Next i EndIf first = false Wend isHeadingNotFirstInText = false End Function Function isHeadingsInText(oText As Object) As Boolean Dim enum1Element As Object Dim enum1 As Object Dim enum2 As Object Dim thisPortion As Object Dim footnoteText As Object Dim label As String Dim labelNum As Integer Dim i As Integer Dim count As Integer Dim cell As Object Dim cellText As Object enum1 = oText.Text.createEnumeration While enum1.hasMoreElements enum1Element = enum1.nextElement If enum1Element.supportsService("com.sun.star.text.Paragraph") Then If enum1Element.OutlineLevel > 0 Then isHeadingsInText = true Exit Function EndIf ElseIf enum1Element.supportsService("com.sun.star.text.TextTable") Then cellNames = enum1Element.cellNames For i = LBound(cellNames) To Ubound(cellNames) cell = enum1Element.getCellByName(cellNames(i)) cellText = cell.getText() If isHeadingsInText(cellText) Then isHeadingsInText = true Exit Function EndIf Next i EndIf Wend isHeadingsInText = false 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