home *** CD-ROM | disk | FTP | other *** search
/ com!online 2001 December / COMCD1201.iso / openoffice / f_0177 / AutoText.xba next >
Encoding:
Extensible Markup Language  |  2001-04-25  |  3.7 KB  |  84 lines
  1. <?xml version="1.0" encoding="UTF-8"?>
  2.  
  3. <script:module xmlns:script="http://openoffice.org/2000/script" script:name="AutoText" script:language="StarBasic">' BASIC
  4. Option Explicit
  5.  
  6. ' Todo: Problem mit der Spaltenbreite l├╢sen
  7. ' Internationale Vorlage f├╝r ├£berschrift
  8. Sub Main
  9. Dim oDocument, oTable, oRows, oDocuText, oTitleCursor as Object
  10. Dim oAutoTextContainer, oAutogroup, oAutoText as Object
  11. Dim oCharStyles, oContentStyle, oHeaderStyle, oGroupTitleStyle as Object
  12. Dim n, m, iAutoCount as Integer
  13.  
  14.         BasicLibraries.LoadLibrary("Tools")
  15.     LoadLanguage(StarDesktop.ISOLocale.Language)
  16.  
  17.     ' Open a new empty document
  18.     oDocument = StarDesktop.LoadComponentFromURL("staroffice:factory/swriter","_blank",0,NoArgs)
  19.     oDocuText = oDocument.Text
  20.  
  21.     ' Create The Character-templates
  22.     oCharStyles = oDocument.StyleFamilies.GetByName("CharacterStyles")
  23.  
  24.     ' The Characterstyle for the Header that describes the Title of Autotextgroups
  25.     oGroupTitleStyle = oDocument.createInstance("com.sun.star.style.CharacterStyle")
  26.     oGroupTitleStyle.charWeight = com.sun.star.awt.FontWeight.BOLD
  27.     oGroupTitleStyle.CharHeight = 14
  28.     oCharStyles.InsertbyName("AutoTextGroupTitle", oGroupTitleStyle)
  29.  
  30.     ' The Characterstyle for the Header that describes the Title of Autotextgroups
  31.     oHeaderStyle = oDocument.createInstance("com.sun.star.style.CharacterStyle")
  32.     oHeaderStyle.charWeight = com.sun.star.awt.FontWeight.BOLD
  33.     oCharStyles.InsertbyName("AutoTextHeading", oHeaderStyle)
  34.  
  35.     ' "Ordinary" Table Content
  36.     oContentStyle = oDocument.createInstance("com.sun.star.style.CharacterStyle")
  37.     oCharStyles.InsertbyName("TableContent", oContentStyle)
  38.  
  39.     oAutoTextContainer = CreateUnoService("com.sun.star.text.AutoTextContainer")
  40.  
  41.     oTitleCursor = oDocuText.CreateTextCursor()
  42.     oTitleCursor.CharStyle = "AutoTextGroupTitle"
  43.     ' Link the Title with the following table
  44.     oTitleCursor.ParaKeepTogether = True
  45.  
  46.     For n = 0 To oAutoTextContainer.Count - 1
  47.         oAutoGroup = oAutoTextContainer.GetByIndex(n)
  48.  
  49.         oTitleCursor.SetString(oAutoGroup.Title)
  50.         oTitleCursor.CollapseToEnd()
  51.            oDocuText.insertControlCharacter(oCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
  52.         oTable = oDocument.CreateInstance("com.sun.star.text.TextTable")
  53.         ' Divide the table if necessary
  54.         oTable.Split = True
  55. '        oTable.KeepTogether = False
  56.         oTable.RepeatHeadLine = True
  57.         oTitleCursor.Text.InsertTextContent(oCursor,oTable,False)
  58.         InsertStringToCell("AutoText-Title",oTable.GetCellbyPosition(0,0), "AutoTextHeading")
  59.         InsertStringToCell("AutoText-Name",oTable.GetCellbyPosition(1,0), "AutoTextHeading")
  60.         ' Insert one row at the bottom of the table
  61.         oRows = oTable.Rows
  62.         iAutoCount = oAutoGroup.Count
  63.         For m = 0 To iAutoCount-1
  64.             ' Insert the name and the title of all Autotexts
  65.             oAutoText = oAutoGroup.GetByIndex(m)
  66.             InsertStringToCell(oAutoGroup.Titles(m), oTable.GetCellbyPosition(0, m + 1), "TableContent")
  67.             InsertStringToCell(oAutoGroup.ElementNames(m), oTable.GetCellbyPosition(1, m + 1), "TableContent")
  68.             If m < iAutoCount-1 Then
  69.                 oRows.InsertbyIndex(m + 2,1)
  70.             End If
  71.         Next m
  72.            oDocuText.insertControlCharacter(oCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
  73.         oCursor.CollapseToEnd()
  74.     Next n
  75. End Sub
  76.  
  77.  
  78. Sub InsertStringToCell(sCellString as String, oCell as Object, sCellStyle as String)
  79. Dim oCellCursor as Object
  80.     oCellCursor = oCell.CreateTextCursor()
  81.     oCellCursor.CharStyle = sCellStyle
  82.     oCell.Text.insertString(oCellCursor,sCellString,False)
  83. End Sub</script:module>
  84.