home *** CD-ROM | disk | FTP | other *** search
/ PC World 2003 April / PCWorld_2003-04_cd.bin / Software / Komercni / openoffice / f_0198 / AutoText.xba next >
Extensible Markup Language  |  2001-10-08  |  4KB  |  96 lines

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