If badText OR badNumberings OR footnotesReport <> "" OR graphicsReport <> "" Or outlineInNotesReport <> "" Or sectionsReport <> "" OR oulineInTablesReport <> "" OR outlinePageStylesReport <> "" Then
result = result & getTranslation("validationBadDrawings") & drawingN & getTranslation("validationExcerptNotSuitable") & chr(10)
result = result & getTranslation("validationBadEmbeededObjects") & badFrame & getTranslation("validationExcerptNotSuitable") & chr(10)
result = result & getTranslation("validateFootnotes1") & " " & Chr(char) & " " & getTranslation("validateFootnotes2") & " " & i & " " & getTranslation("validateFootnotes3") & chr(10)
result = result & getTranslation("validateFootnotes1") & " " & Chr(char) & " " & getTranslation("validateEndnotes1") & " " & i & " " & getTranslation("validateFootnotes3") & chr(10)
result = result & getTranslation("validateFootnotes2") & " " & x & " " & getTranslation("setOutlineLevel") & " " & oCurPar.OutlineLevel & chr(10)
result = result & getTranslation("validateEndnotes1") & " " & x & " " & getTranslation("setOutlineLevel") & " " & oCurPar.OutlineLevel & chr(10)
If anchorText.supportsService("com.sun.star.text.CellProperties") Then
result = result & getTranslation("section") & " " & section.Name & " " & getTranslation("isInTable") & chr(10)
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)
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
tmp = getTranslation("validateNumberingLevel") &" " & (j + 1) & " " & getTranslation("validateNumberingFont") & " " & fontName & " " & getTranslation("validateNumberingSymbol") & " " & fontChar & " (" & Hex(Asc(fontChar)) & ") "& Left(excerpt,exLength) & chr(10)
If targetFontName="0" or targetFontName="" Then
Exit sub
EndIf
getCharsInFont(targetFontName)
statusIndicator.end()
End Sub
Sub onSelectFont(oEvent)
fontDialog.endExecute()
fontDialog.model.Tag = oEvent.ActionCommand
End Sub
Function getODGFontNames() As Variant
Dim fontNames() 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 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)
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
fontName = thisPortion.CharFontName
If NOT fontIsAlreadyFound(fontNames, fontName) Then
AddToArray(fontNames, fontName)
EndIf
Wend
EndIf
Wend
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
Sub getCharsInFont(fontName As String)
Dim resultArray() As String
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 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)
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
fontChar = Hex(Asc(Mid(resultString,k+1,1)))
If NOT IsInArray(resultArray,fontChar) Then
AddToArray(resultArray(), fontChar)
EndIf
Next k
EndIf
Wend
EndIf
Wend
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><br>" & Chr(10)
Next i
If resultString <> "" Then
'MsgBox "Символы в шрифте "& fontName &Chr(10)&resultString
FileName = path & "/symbolsInFont" & fontName & ".html"
n = FreeFile() 'Next free file number
Open FileName For Output Access Read Write As #n 'Open for read/write
Print #n, "<html><body><p>Symbols in font "& fontName &":</p>"&resultString &"</body><html>"
Close #n
MsgBox "Отчёт о найденных символах в шрифте "& fontName &" можно открыть в " & FileName
Else
MsgBox "Символов в шрифте " & fontName & " найдено не было"
