D7net
Home
Console
Upload
information
Create File
Create Folder
About
Tools
:
/
lib
/
libreoffice
/
share
/
basic
/
Gimmicks
/
Filename :
GetTexts.xba
back
Copy
<?xml version="1.0" encoding="UTF-8"?> <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> <!-- * This file is part of the LibreOffice project. * * This Source Code Form is subject to the terms of the Mozilla Public * License, v. 2.0. If a copy of the MPL was not distributed with this * file, You can obtain one at http://mozilla.org/MPL/2.0/. * * This file incorporates work covered by the following license notice: * * Licensed to the Apache Software Foundation (ASF) under one or more * contributor license agreements. See the NOTICE file distributed * with this work for additional information regarding copyright * ownership. The ASF licenses this file to you under the Apache * License, Version 2.0 (the "License"); you may not use this file * except in compliance with the License. You may obtain a copy of * the License at http://www.apache.org/licenses/LICENSE-2.0 . --> <script:module xmlns:script="http://openoffice.org/2000/script" script:name="GetTexts" script:language="StarBasic">Option Explicit ' Description: ' This macro extracts the strings out of the currently active document and inserts them into a log document. ' The aim of the macro is to provide the programmer an insight into the OpenOffice API. ' It focuses on how document objects are accessed. ' Therefore 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/Impress 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 = CreateNewDocument("swriter") If Not IsNull(oLogDocument) Then 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.DocumentProperties.Title <> "" Then oHyperCursor.HyperlinkName = oDocument.DocumentProperties.Title End If oLogText.insertString(oHyperCursor, oDocument.DocumentProperties.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 GetDocumentProps() Select Case sDocType Case "swriter" GetWriterStrings() Case "scalc" GetCalcStrings() Case "sdraw", "simpress" GetDrawStrings() Case Else Msgbox("This macro only works with a Writer, Calc or Draw/Impress document.", 16, GetProductName()) End Select End If 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. ' Therefore 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/Impress 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 GetDocumentProps() Dim oDocuProps as Object MakeLogHeadLine("Document Properties") oDocuProps = oDocument.DocumentProperties WriteStringToLogFile(oDocuProps.Title) WriteStringToLogFile(oDocuProps.Description) WriteStringToLogFile(oDocuProps.Subject) WriteStringToLogFile(oDocuProps.Author) ' WriteStringToLogFile(oDocuProps.UserDefinedProperties.ReplyTo) ' WriteStringToLogFile(oDocuProps.UserDefinedProperties.Recipient) ' WriteStringToLogFile(oDocuProps.UserDefinedProperties.References) ' WriteStringToLogFile(oDocuProps.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 ' ***********************************************Log document************************************************** 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>