diff --git a/IPHRedaction/Validation.xba b/IPHRedaction/Validation.xba index 18fa2ae..013a180 100644 --- a/IPHRedaction/Validation.xba +++ b/IPHRedaction/Validation.xba @@ -1,22 +1,113 @@ -Sub markYX +Sub markZ 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 - removeBadCharacters + Dim footnotesReport As String + Dim graphicsReport As String + Dim badText As Boolean + Dim badNumberings As Boolean + Dim badFootnoteSigns As Boolean + Dim badGraphics 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 + 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 + Dim shapeType As String + Dim oleN As Long + oleN = 0 + Dim graphicN As Long + graphicN = 0 + Dim formulaN As Long + formulaN = 0 + Dim frameShapeN As Long + frameShapeN = 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 + Next i + If drawingN <> 0 Then + result = "В документе найдены рисунки (" & drawingN & "), неподходящие для публикации." + EndIf + checkGraphics = result +End Function + Private Sub removeBadCharacters StartTracking AskAndReplace("[\uE000-\uF8FF]+","") - checkAllFootnotes + StopTracking showTrackedChanges End Sub -Private Sub checkAllFootnotes() +Private Function checkAllFootnotes() Dim footnotes As Object Dim count as Integer Dim charNum as Long @@ -34,16 +125,12 @@ Private Sub checkAllFootnotes() 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) - 'Mri footnote - 'footNote.setLabel(Left(label,j-1) & "*" & Right(label,charNum-j)) + result = result & "Символ "& Chr(char) &" сноски "& i &" не подходит для публикации"& chr(10) End If Next j Next i - If result <> "" then - MsgBox result - EndIf -End Sub + checkAllFootnotes = result +End Function Private Sub showTrackedChanges dim document as object diff --git a/redaction.oxt b/redaction.oxt index f300c40..770bd36 100644 Binary files a/redaction.oxt and b/redaction.oxt differ