Sub markval21 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.SearchCaseSensitive = true 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 Sub fixDOI StartTracking replaceCharsInDOI StopTracking showTrackedChanges End Sub Sub replaceCharsInDOI AskAndReplace("(?<=DOI[0-9. /XVI:‒–—−ХOО?-]{1,50})[Х]{1,5}","X") AskAndReplace("(?<=DOI[0-9. /XVI:‒–—−ХOО?-]{1,50})[OО]{1,5}","0") AskAndReplace("(?<=DOI[0-9. /XVI:‒–—−ХOО?-]{1,50})[‒–—−]{1,5}","-") 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 Dim fontDialog As Object Sub fontReportButton Dim fontNames() As String Dim listBox As Object Dim description As Object Dim statusIndicator as Object statusIndicator = ThisComponent.getCurrentController.statusIndicator statusIndicator.Start(getTranslation("fontReportInProgress"),100) fontNames = getODGFontNames() DialogLibraries.LoadLibrary("Redaction") fontDialog = CreateUnoDialog( DialogLibraries.Redaction.ChooseFontname ) listBox = fontDialog.getControl("fontList") listBox.addItems(fontNames , 0) fontDialog.Title = getTranslation("chooseFontNameDialogTitle") description = fontDialog.getControl("description") description.SetText(getTranslation("chooseFontNameDialogDescription")) statusIndicator.setValue(50) fontDialog.Execute() Dim targetFontName As String targetFontName = fontDialog.model.Tag If targetFontName="0" or targetFontName="" Then statusIndicator.end() Exit sub EndIf Dim FileName As String FileName = getCharsInFont(targetFontName) statusIndicator.end() If FileName <> "" Then openReport(FileName) EndIf End Sub Sub onSelectFont(oEvent) fontDialog.endExecute() fontDialog.model.Tag = oEvent.ActionCommand End Sub Function getODGFontNames() As Variant 'Globalscope.BasicLibraries.LoadLibrary( "MRILib" ) Dim fontNames() As String Dim pages As Object Dim pageCount As Long Dim page As Object Dim elementCount As Long Dim groupCount As Long Dim i As Long Dim j As Long Dim k As Long Dim element As Object Dim elementText As Object Dim groupElement As Object Dim enum1 As Object Dim enum1Element As Object Dim enum2 As Object Dim thisPortion As Object Dim fontChar As Long Dim fontName As String pages = ThisComponent.getDrawPages() pagesCount = pages.getCount() For i = 0 To pagesCount - 1 page = pages.getByIndex(i) elementCount = page.getCount() For j = 0 To elementCount - 1 element = page.getByIndex(j) If element.supportsService("com.sun.star.drawing.Text") Then elementText = element.getText() enum1 = elementText.createEnumeration() While enum1.hasMoreElements enum1Element = enum1.nextElement If enum1Element.supportsService("com.sun.star.text.Paragraph") Then enum2 = enum1Element.createEnumeration While enum2.hasMoreElements thisPortion = enum2.nextElement If Len(thisPortion.String) > 0 Then fontName = thisPortion.CharFontName If NOT fontIsAlreadyFound(fontNames, fontName) Then AddToArray(fontNames, fontName) EndIf EndIf Wend EndIf Wend EndIf If element.supportsService("com.sun.star.drawing.GroupShape") Then groupCount = element.getCount() For k = 0 To groupCount - 1 groupElement = element.getByIndex(k) If groupElement.supportsService("com.sun.star.drawing.Text") Then elementText = groupElement.getText() enum1 = elementText.createEnumeration() While enum1.hasMoreElements enum1Element = enum1.nextElement If enum1Element.supportsService("com.sun.star.text.Paragraph") Then enum2 = enum1Element.createEnumeration While enum2.hasMoreElements thisPortion = enum2.nextElement If Len(thisPortion.String) > 0 Then fontName = thisPortion.CharFontName If NOT fontIsAlreadyFound(fontNames, fontName) Then AddToArray(fontNames, fontName) EndIf EndIf Wend EndIf Wend EndIf Next k EndIf Next j Next i getODGFontNames = fontNames End Function Function fontIsAlreadyFound(fontNames() As String, proposeName As String) As Boolean If IsEmpty(fontNames) Then fontIsAlreadyFound = false Exit Function EndIf If getIndex(fontNames(), proposeName) > -1 Then fontIsAlreadyFound = True Exit Function EndIf fontIsAlreadyFound = False End Function Function IsInArray(array, content) IsInArray = false For i = LBound(array) To UBound(array) inArr = array(i) If inArr = content Then IsInArray = true EndIf Next i End Function Function getIndex(array As variant, value As variant) As Integer Dim id As Integer Dim nRight As Integer Dim nLen As Integer id = 0 nRight = uBound(array) nLen = len(value) while id <= nRight If array(id) = value Then getIndex = id exit Function Else id = id + 1 end if wend getIndex = -1 End Function Sub addToArray(xArray(),vNextElement) Dim iUB As Integer Dim iLB As Integer iLB = lBound(xArray()) iUB = uBound(xArray()) If iLB > iUB then iUB = iLB redim xArray(iLB To iUB) Else iUB = iUB +1 redim preserve xArray(iLB To iUB) Endif xArray(iUB) = vNextElement End Sub Function getCharsInFont(fontName As String) As String Dim resultArray() As String Dim pageNums() As Long Dim firstPages() As Long Dim resultString As String Dim pages As Object Dim pageCount As Long Dim page As Object Dim elementCount As Long Dim i As Long Dim j As Long Dim k As Long Dim element As Object Dim elementText As Object Dim enum1 As Object Dim enum1Element As Object Dim enum2 As Object Dim thisPortion As Object Dim fontChar As String Dim groupCount As Long Dim groupElement As Object Dim charString As String Dim charNum As Long pages = ThisComponent.getDrawPages() pagesCount = pages.getCount() For i = 0 To pagesCount - 1 page = pages.getByIndex(i) elementCount = page.getCount() For j = 0 To elementCount - 1 element = page.getByIndex(j) If element.supportsService("com.sun.star.drawing.Text") Then elementText = element.getText() enum1 = elementText.createEnumeration() While enum1.hasMoreElements enum1Element = enum1.nextElement If enum1Element.supportsService("com.sun.star.text.Paragraph") Then enum2 = enum1Element.createEnumeration While enum2.hasMoreElements thisPortion = enum2.nextElement If thisPortion.CharFontName = fontName Then resultString = thisPortion.String For k = 0 To Len(resultString) - 1 charString = Mid(resultString,k+1,1) charNum = Asc(charString) fontChar = Hex(charNum) If NOT IsInArray(resultArray,fontChar) Then AddToArray(resultArray(), fontChar) AddToArray(pageNums(), i + 1) EndIf Next k EndIf Wend EndIf Wend EndIf If element.supportsService("com.sun.star.drawing.GroupShape") Then groupCount = element.getCount() For k = 0 To groupCount - 1 groupElement = element.getByIndex(k) If groupElement.supportsService("com.sun.star.drawing.Text") Then elementText = groupElement.getText() enum1 = elementText.createEnumeration() While enum1.hasMoreElements enum1Element = enum1.nextElement If enum1Element.supportsService("com.sun.star.text.Paragraph") Then enum2 = enum1Element.createEnumeration While enum2.hasMoreElements thisPortion = enum2.nextElement If thisPortion.CharFontName = fontName Then resultString = thisPortion.String For k = 0 To Len(resultString) - 1 fontChar = Hex(Asc(Mid(resultString,k+1,1))) If NOT IsInArray(resultArray,fontChar) Then AddToArray(resultArray(), fontChar) AddToArray(pageNums(), i + 1) EndIf Next k EndIf Wend EndIf Wend EndIf Next k EndIf Next j Next i resultString = "" For i = LBound(resultArray) To UBound(resultArray) resultString = resultString & "<a href='https://unicode-table.com/ru/" & resultArray(i) & "'" & ">https://unicode-table.com/ru/" & resultArray(i) & "</a> " & getTranslation("charFirstPage") & " " & pageNums(i) & "<br>" & Chr(10) Next i If resultString <> "" Then 'MsgBox "Символы в шрифте "& fontName &Chr(10)&resultString Dim FileName As String 'Holds the file name Dim n As Integer 'Holds the file number Dim f As Integer 'Index variable Dim s As String 'Temporary string for input Dim fileaccess As Object Dim outtextstream As Object Dim out As Object Dim sTemp$ GlobalScope.BasicLibraries.loadLibrary("Tools") path=DirectoryNameoutofPath(ThisComponent.getURL(),"/") FileName = path & "/symbolsInFont" & fontName & ".html" 'n = FreeFile() 'Next free file number 'Open FileName For Output Access Read Write As #n 'Open for read/write fileaccess = createUnoService ("com.sun.star.ucb.SimpleFileAccess") outtextstream = createUnoService ("com.sun.star.io.TextOutputStream") outtextstream.setEncoding( "UTF-8" ) out = fileaccess.openFileWrite( FileName ) outtextstream.setOutputStream( out ) outtextstream.writeString( "<html><head><title>" & getTranslation("symbolsInFontHeading") & " "& fontName & "</title></head><body><h2>" & getTranslation("symbolsInFontHeading") & " "& fontName &":</h2>"&resultString &"</body></html>" ) outtextstream.closeOutput() getCharsInFont = FileName Exit Function Else MsgBox getTranslation("symbolsInFontNotFound1") & " " & fontName & " " & getTranslation("symbolsInFontNotFound2") getCharsInFont = "" Exit Function EndIf End Function sub openReport(fileName As String) dim document as object dim dispatcher as object Dim path As String Dim tmpName As String Dim oldName As String document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dim args1(1) as new com.sun.star.beans.PropertyValue args1(0).Name = "URL" args1(0).Value = fileName args1(1).Name = "FilterName" args1(1).Value = "HTML (StarWriter)" dispatcher.executeDispatch(document, ".uno:Open", "", 0, args1()) If FileExists(tmpName) Then Kill(tmpName) End If End Sub