PC World 2002 June/PCWorld_2002-06_cd.bin/Software/Komercni/openoffice/install/f_0188/GetTexts.xba

Extensible Markup Language | 2001-10-08 | 17KB | 529 lines

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="GetTexts" script:language="StarBasic">Option Explicit
' Option f├╝r doppelte Strings
' Alternativtexte, Namen usw f├╝r HTML-Seiten--> ist Anbindung an StarOfficeAPI geplant?
' Verlustanzeige "Wo ist Peggy?"
' Überschriften für Textfelder
' GetTextFrames mit Peter absprechen
' Ole - Objekte auch mit einbeziehen?
' Redimensionierung des LogArrays, wenn Implementierung so weit ist
' Namen von Notizenseiten mit Peter durchsprechen

' Macro-Description:
' This Macro extracts the Strings out of the currently activated document und inserts them into a logdocument
' The aim of the macro is to provide the programmer an insight into the StarOffice API
' It focusses on how document-Objects are accessed.
' Therefor not only texts of the document-body are retrieved but also Texts of general
' document Objects like, Annotations, charts and general Document Information

Public oLogDocument, oLogText, oLogCursor, oLogHeaderStyle, oLogBodyTextStyle as Object
Public oDocument as Object
Public LogArray(1000) as String
Public LogIndex as Integer
Public oLocHeaderStyle as Object

Sub Main
Dim sDocType as String
Dim oHyperCursor as Object
Dim oCharStyles as Object
    BasicLibraries.LoadLibrary("Tools")
    On Local Error GoTo NODOCUMENT
    oDocument = StarDesktop.ActiveFrame.Controller.Model
    sDocType = GetDocumentType(oDocument)
    NODOCUMENT:
    If Err <> 0 Then
        Msgbox("This macro extracts all data from the active Writer, Calc or Draw document." & chr(13) &_
               "To start this macro you have to activate a document first." , 16, GetProductName)
        Exit Sub
    End If
    On Local Error Goto 0

    ' Open a new document where all the texts are inserted
    oLogDocument = StarDesktop.LoadComponentFromURL( "private:factory/swriter","_blank",0,NoArgs())
    oLogText = oLogDocument.Text

    ' create and define the character styles of the Log-document
    oCharStyles = oLogDocument.StyleFamilies.GetByName("CharacterStyles")
    oLogHeaderStyle = oLogDocument.createInstance("com.sun.star.style.CharacterStyle")
    oCharStyles.InsertbyName("Log Header", oLogHeaderStyle)

    oLogHeaderStyle.charWeight = com.sun.star.awt.FontWeight.BOLD
    oLogBodyTextStyle = oLogDocument.createInstance("com.sun.star.style.CharacterStyle")
    oCharStyles.InsertbyName("Log Body", oLogBodyTextStyle)

    ' Insert the title of the activated document as a hyperlink
    oHyperCursor = oLogText.createTextCursor()
    oHyperCursor.CharWeight = com.sun.star.awt.FontWeight.BOLD
    oHyperCursor.gotoStart(False)
    oHyperCursor.HyperLinkURL = oDocument.URL
    oHyperCursor.HyperLinkTarget = oDocument.URL
    If oDocument.DocumentInfo.Title <> "" Then
        oHyperCursor.HyperlinkName = oDocument.DocumentInfo.Title
    End If
    oLogText.insertString(oHyperCursor, oDocument.DocumentInfo.Title, False)
    oLogText.insertControlCharacter(oHyperCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)

    oLogCursor = oLogText.createTextCursor()
    oLogCursor.GotoEnd(False)
    ' "Switch off" the Hyperlink - Properties
    oLogCursor.SetPropertyToDefault("HyperLinkURL")
    oLogCursor.SetPropertyToDefault("HyperLinkTarget")
    oLogCursor.SetPropertyToDefault("HyperLinkName")
    LogIndex = 0

    ' Get the Properties of the document Info
    GetDocumentInfo()

    Select Case sDocType
        Case "swriter"
            GetWriterStrings()
        Case "scalc"
            GetCalcStrings()
        Case "sdraw"
            GetDrawStrings()
        Case Else
            Msgbox("This macro only works with a Writer, Calc or Draw/Impress document.", 16, GetProductName())
    End Select

End Sub


' ***********************************************Calc-Documents**************************************************

Sub GetCalcStrings()
Dim i, n as integer
Dim oSheet as Object
Dim SheetName as String
Dim oSheets as Object
    ' Create a sequence of all sheets within the document
    oSheets = oDocument.Sheets

    For i = 0 to osheets.Count - 1
        oSheet = osheets.GetbyIndex(i)
        SheetName = oSheet.Name
        MakeLogHeadLine("Sheet No. " & i & "(" & SheetName & ")" )

        ' Check the "body" of the sheet
        GetCellTexts(oSheet)

        If oSheet.IsScenario then
            MakeLogHeadLine("Scenario Comments from " & SheetName & "'")
            WriteStringtoLogFile(osheet.ScenarioComment)
        End if

        GetAnnotations(oSheet, "Annotations from '" & SheetName & "'")

        GetChartStrings(oSheet, "Charts from '" & SheetName & "'")

        GetControlStrings(oSheet.DrawPage, "Controls from '" & SheetName & "'")
    Next

    ' Pictures
    GetCalcGraphicNames()

    GetNamedRanges()
End Sub


Sub GetCellTexts(oSheet as Object)
Dim BigRange, BigEnum, oCell as Object
    BigRange = oDocument.CreateInstance("com.sun.star.sheet.SheetCellRanges")
    BigRange.InsertbyName("",oSheet)
    BigEnum = BigRange.GetCells.CreateEnumeration
    While BigEnum.hasmoreElements
        oCell = BigEnum.NextElement
        If oCell.String <> "" And Val(oCell.String) = 0then
            WriteStringtoLogFile(oCell.String)
        End If
    Wend
End Sub


Sub GetAnnotations(oSheet as Object, HeaderLine as String)
Dim oNotes as Object
Dim n as Integer
    oNotes = oSheet.getAnnotations
    If oNotes.hasElements() then
        MakeLogHeadLine(HeaderLine)
        For n = 0 to oNotes.Count-1
            WriteStringtoLogFile(oNotes.GetbyIndex(n).String)
        Next
    End if
End Sub


Sub GetNamedRanges()
Dim i as integer
    MakeLogHeadLine("Named Ranges")
    For i = 0 To oDocument.NamedRanges.Count - 1
        WriteStringtoLogFile(oDocument.NamedRanges.GetbyIndex(i).Name)
    Next
End Sub


Sub GetCalcGraphicNames()
Dim n,m as integer
    MakeLogHeadLine("Graphics")
    For n = 0 To oDocument.Drawpages.count-1
        For m = 0 To oDocument.Drawpages.GetbyIndex(n).Count - 1
            WriteStringtoLogFile(oDocument.DrawPages.GetbyIndex(n).GetbyIndex(m).Text.String)
        Next m
    Next n
End Sub


' ***********************************************Writer-Documents**************************************************

Sub GetParagraphTexts(oParaObject as Object, HeadLine as String)
Dim ParaEnum as Object
Dim oPara as Object
Dim oTextPortEnum as Object
Dim oTextPortion as Object
Dim i as integer
Dim oCellNames()
Dim oCell as Object

    MakeLogHeadLine(HeadLine)
    ParaEnum = oParaObject.Text.CreateEnumeration

    While ParaEnum.HasMoreElements
        oPara = ParaEnum.NextElement

        ' Note: The Enumeration ParaEnum lists all tables and Paragraphs.
        ' Therefor we have to find out what kind of object "oPara" actually is
        If oPara.supportsService("com.sun.star.text.Paragraph") Then
            ' "oPara" is a Paragraph
            oTextPortEnum = oPara.createEnumeration
            While oTextPortEnum.hasmoreElements
                oTextPortion = oTextPortEnum.nextElement()
                WriteStringToLogFile(oTextPortion.String)
            Wend
        Else
            ' "oPara" is a table
            oCellNames = oPara.CellNames
            For i = 0 To Ubound(oCellNames())
                If oCellNames(i) <> "" Then
                    oCell = oPara.getCellByName(oCellNames(i))
                    WriteStringToLogFile(oCell.String)
                End If
            Next
        End If
    Wend
End Sub



Sub GetChartStrings(oSheet as Object, HeaderLine as String)
Dim i as Integer
Dim aChartObject as Object
Dim aChartDiagram as Object

    MakeLogHeadLine(HeaderLine)

    For i = 0 to oSheet.Charts.Count-1
        aChartObject = oSheet.Charts.GetByIndex(i).EmbeddedObject
        If aChartObject.HasSubTitle then
            WriteStringToLogFile(aChartObject.SubTitle.String)
        End If

        If aChartObject.HasMainTitle then
            WriteStringToLogFile(aChartObject.Title.String)
        End If

        aChartDiagram = aChartObject.Diagram

        If aChartDiagram.hasXAxisTitle Then
            WriteStringToLogFile(aChartDiagram.XAxisTitle)
        End If

        If aChartDiagram.hasYAxisTitle Then
            WriteStringToLogFile(aChartDiagram.YAxisTitle)
        End If

        If aChartDiagram.hasZAxisTitle Then
            WriteStringToLogFile(aChartDiagram.ZAxisTitle)
        End If
    Next i
End Sub



Sub GetFrameTexts()
Dim i as integer
Dim oTextFrame as object
Dim oFrameEnum as Object
Dim oFramePort as Object
Dim oFrameTextEnum as Object
Dim oFrameTextPort as Object

    MakeLogHeadLine("Text Frames")
    For i = 0 to oDocument.TextFrames.Count-1
        oTextFrame = oDocument.TextFrames.GetbyIndex(i)
        WriteStringToLogFile(oTextFrame.Name)

        ' Is the frame bound to the Page
        If oTextFrame.AnchorType  = com.sun.star.text.TextContentAnchorType.AT_PAGE  Then
            GetParagraphTexts(oTextFrame, "Text Frame Contents")
        End If

        oFrameEnum = oTextFrame.CreateEnumeration
        While oFrameEnum.HasMoreElements
            oFramePort = oFrameEnum.NextElement
            If oFramePort.supportsService("com.sun.star.text.Paragraph") then
                oFrameTextEnum = oFramePort.createEnumeration
                While oFrameTextEnum.HasMoreElements
                    oFrameTextPort = oFrameTextEnum.NextElement
                    If oFrameTextPort.SupportsService("com.sun.star.text.TextFrame") Then
                        WriteStringtoLogFile(oFrameTextPort.String)
                    End If
                Wend
            Else
                WriteStringtoLogFile(oFramePort.Name)
            End if
        Wend
    Next
End Sub


Sub GetTextFieldStrings()
Dim aTextField as Object
Dim i as integer
Dim CurElement as Object
    MakeLogHeadLine("Text Fields")
    aTextfield = oDocument.getTextfields.CreateEnumeration
    While aTextField.hasmoreElements
        CurElement = aTextField.NextElement
        If CurElement.PropertySetInfo.hasPropertybyName("Content") Then
            WriteStringtoLogFile(CurElement.Content)
        ElseIf CurElement.PropertySetInfo.hasPropertybyName("PlaceHolder") Then
            WriteStringtoLogFile(CurElement.PlaceHolder)
            WriteStringtoLogFile(CurElement.Hint)
        ElseIf Curelement.TextFieldMaster.PropertySetInfo.HasPropertybyName("Content") then
            WriteStringtoLogFile(CurElement.TextFieldMaster.Content)
        End If
    Wend
End Sub



Sub GetLinkedFileNames()
Dim oDocSections as Object
Dim LinkedFileName as String
Dim i as Integer
    If Right(oDocument.URL,3) = "sgl" Then
        MakeLogHeadLine("Sub-documents")
        oDocSections = oDocument.TextSections
        For i = 0 to oDocSections.Count - 1
            LinkedFileName = oDocSections.GetbyIndex(i).FileLink.FileURL
            If LinkedFileName <> "" Then
                WriteStringToLogFile(LinkedFileName)
            End If
        Next i
    End If
End Sub


Sub GetSectionNames()
Dim i as integer
Dim oDocSections as Object
    MakeLogHeadLine("Sections")
    oDocSections = oDocument.TextSections
    For i = 0 to oDocSections.Count-1
        WriteStringtoLogFile(oDocSections.GetbyIndex(i).Name)
    Next
End Sub


Sub GetWriterStrings()
    GetParagraphTexts(oDocument, "Document Body")
    GetGraphicNames()
    GetStyles()
    GetControlStrings(oDocument.DrawPage, "Controls")
    GetTextFieldStrings()
    GetSectionNames()
    GetFrameTexts()
    GetHyperLinks
    GetLinkedFileNames()
End Sub


' ***********************************************Draw-Documents**************************************************

Sub GetDrawPageTitles(LocObject as Object)
Dim n as integer
Dim oPage as Object

    For n = 0 to LocObject.Count - 1
        oPage = LocObject.GetbyIndex(n)
        WriteStringtoLogFile(oPage.Name)
        ' Is the Page a DrawPage and not a MasterPage?
        If oPage.supportsService("com.sun.star.drawing.DrawPage")then
            ' Get the Name of the NotesPage (only relevant for Impress-Documents)
            If oDocument.supportsService("com.sun.star.presentation.PresentationDocument") then
                WriteStringtoLogFile(oPage.NotesPage.Name)
            End If
        End If
    Next
End Sub


Sub GetPageStrings(oPages as Object)
Dim m, n, s as Integer
Dim oPage, oPageElement, oShape as Object
    For n = 0 to oPages.Count-1
        oPage = oPages.GetbyIndex(n)
        If oPage.HasElements then
            For m = 0 to oPage.Count-1
                oPageElement = oPage.GetByIndex(m)
                If HasUnoInterfaces(oPageElement,"com.sun.star.container.XIndexAccess") Then
                    ' The Object "oPageElement" a group of Shapes, that can be accessed by their index
                    For s = 0 To oPageElement.Count - 1
                        WriteStringToLogFile(oPageElement.GetByIndex(s).String)
                    Next s
                ElseIf HasUnoInterfaces(oPageElement, "com.sun.star.text.XText") Then
                    WriteStringtoLogFile(oPageElement.String)
                End If
            Next
        End If
    Next
End Sub


Sub GetDrawStrings()
Dim oDPages, oMPages as Object

    oDPages = oDocument.DrawPages
    oMPages = oDocument.Masterpages

    MakeLogHeadLine("Titles")
    GetDrawPageTitles(oDPages)
    GetDrawPageTitles(oMPages)

    MakeLogHeadLine("Document Body")
    GetPageStrings(oDPages)
    GetPageStrings(oMPages)
End Sub


' ***********************************************Misc**************************************************

Sub GetDocumentInfo()
Dim oDocuInfo as Object
    MakeLogHeadLine("Document Properties")
    oDocuInfo = oDocument.DocumentInfo
    WriteStringToLogFile(oDocuInfo.Title)
    WriteStringToLogFile(oDocuInfo.Description)
    WriteStringToLogFile(oDocuInfo.Theme)
    WriteStringToLogFile(oDocuInfo.Author)
    WriteStringToLogFile(oDocuInfo.ReplyTo)
    WriteStringToLogFile(oDocuInfo.Recipient)
    WriteStringToLogFile(oDocuInfo.References)
    WriteStringToLogFile(oDocuInfo.Keywords)
End Sub


Sub GetHyperlinks()
Dim i as integer
Dim oCrsr as Object
Dim oAllHyperLinks as Object
Dim SrchAttributes(0) as new com.sun.star.beans.PropertyValue
Dim oSearchDesc as Object

    MakeLogHeadLine("Hyperlinks")
    ' create a Search-Descriptor
    oSearchDesc = oDocument.CreateSearchDescriptor
    oSearchDesc.Valuesearch = False

    ' define the Search-attributes
    srchattributes(0).Name = "HyperLinkURL"
    srchattributes(0).Value = ""
    oSearchDesc.SetSearchAttributes(SrchAttributes())

    oAllHyperLinks = oDocument.findAll(oSearchDesc())

    For i = 0 to oAllHyperLinks.Count - 1
        oFound = oAllHyperLinks(i)
        oCrsr = oFound.Text.createTextCursorByRange(oFound)
        WriteStringToLogFile(oCrs.HyperLinkURL)       'Url
        WriteStringToLogFile(oCrs.HyperLinkTarget)    'Name
        WriteStringToLogFile(oCrs.HyperLinkName)    'Frame
    Next i
End Sub


Sub GetGraphicNames()
Dim i as integer
Dim oDocGraphics as Object
    MakeLogHeadLine("Graphics")
    oDocGraphics = oDocument.GraphicObjects
    For i = 0 to oDocGraphics.count - 1
        WriteStringtoLogFile(oDocGraphics.GetbyIndex(i).Name)
    Next
End Sub


Sub GetStyles()
Dim m,n as integer
    MakeLogHeadLine("User-defined Templates")

    ' Check all StyleFamilies(i.e. PageStyles, ParagraphStyles, CharacterStyles, cellStyles)
    For n = 0 to oDocument.StyleFamilies.Count - 1
        For m = 0 to oDocument.StyleFamilies.getbyIndex(n).Count-1
            If oDocument.StyleFamilies.GetbyIndex(n).getbyIndex(m).IsUserDefined then
                WriteStringtoLogFile(oDocument.StyleFamilies.GetbyIndex(n).getbyIndex(m).Name)
            End If
        Next
    Next
End Sub


Sub GetControlStrings(oDPage as Object, HeaderLine as String)
Dim aForm as Object
Dim m,n as integer
    MakeLogHeadLine(HeaderLine)
    'SearchFor all possible Controls
    For n = 0 to oDPage.Forms.Count - 1
        aForm = oDPage.Forms(n)
        For m = 0 to aForm.Count-1
            GetControlContent(aForm.GetbyIndex(m))
        Next
    Next
End Sub


Sub GetControlContent(LocControl as Object)
Dim i as integer

    If LocControl.PropertySetInfo.HasPropertybyName("Label") then
        WriteStringtoLogFile(LocControl.Label)

    ElseIf LocControl.SupportsService("com.sun.star.form.component.ListBox") then
        For i = 0 to Ubound(LocControl.StringItemList())
            WriteStringtoLogFile(LocControl.StringItemList(i))
        Next
    End If
    If LocControl.PropertySetInfo.HasPropertybyName("HelpText") then
        WriteStringtoLogFile(LocControl.Helptext)
    End If
End Sub

' ***********************************************LogDocument**************************************************

Sub WriteStringtoLogFile( sString as String)
    If (Not FieldInArray(LogArray(),LogIndex,sString))AND (NOT ISNULL(sString)) Then
        LogArray(LogIndex) = sString
        LogIndex = LogIndex + 1
        oLogText.insertString(oLogCursor,sString,False)
           oLogText.insertControlCharacter(oLogCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
    End If
End Sub


Sub MakeLogHeadLine(HeadText as String)
    oLogCursor.CharStyleName = "Log Header"
    oLogText.insertControlCharacter(oLogCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
    oLogText.insertString(oLogCursor,HeadText,False)
    oLogText.insertControlCharacter(oLogCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
    oLogCursor.CharStyleName = "Log Body"
End Sub</script:module>