Quelle  Autotext.xba   Sprache: unbekannt

<?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="Autotext" script:language="StarBasic">Option Explicit

Public UserfieldDataType(14) as String
Public oDocAuto as Object
Public BulletList(7) as Integer
Public sTextFieldNotDefined as String
Public sGeneralError as String


Sub Main()
 Dim oCursor as Object
 Dim oStyles as Object
 Dim oSearchDesc as Object
 Dim oFoundall as Object
 Dim oFound as Object
 Dim i as Integer
 Dim sFoundString as String
 Dim sFoundContent as String
 Dim FieldStringThere as String
 Dim ULStringThere as String
 Dim PHStringThere as String
 On Local Error Goto GENERALERROR
 ' Initialization...
    BasicLibraries.LoadLibrary("Tools")
 If InitResources("'Template'") Then
  sGeneralError = GetResText("CorrespondenceMsgError")
  sTextFieldNotDefined = GetResText("TextField")
 End If

 UserfieldDatatype(0) = "COMPANY"
 UserfieldDatatype(1) = "FIRSTNAME"
 UserfieldDatatype(2) = "NAME"
 UserfieldDatatype(3) = "SHORTCUT"
 UserfieldDatatype(4) = "STREET"
 UserfieldDatatype(5) = "COUNTRY"
 UserfieldDatatype(6) = "ZIP"
 UserfieldDatatype(7) = "CITY"
 UserfieldDatatype(8) = "TITLE"
 UserfieldDatatype(9) = "POSITION"
 UserfieldDatatype(10) = "PHONE_PRIVATE"
 UserfieldDatatype(11) = "PHONE_COMPANY"
 UserfieldDatatype(12) = "FAX"
 UserfieldDatatype(13) = "EMAIL"
 UserfieldDatatype(14) = "STATE"
 BulletList(0) = 149
 BulletList(1) = 34
 BulletList(2) = 65
 BulletList(3) = 61
 BulletList(4) = 49
 BulletList(5) = 47
 BulletList(6) = 79
 BulletList(7) = 58

 oDocAuto = ThisComponent
 oStyles = oDocAuto.Stylefamilies.GetByName("NumberingStyles")

 ' Prepare the Search-Descriptor
 oSearchDesc = oDocAuto.createsearchDescriptor()
 oSearchDesc.SearchRegularExpression = True
 oSearchDesc.SearchWords = True
 oSearchDesc.SearchString  = "<[^>]+>"
 oFoundall = oDocAuto.FindAll(oSearchDesc)

 'Loop over the foundings
 For i = 0 To oFoundAll.Count - 1
  oFound = oFoundAll.GetByIndex(i)
  sFoundString = oFound.String
  'Extract the string inside the brackets
  sFoundContent = FindPartString(sFoundString,"<",">",1)
  sFoundContent = LTrim(sFoundContent)

  ' Define the Cursor and place it on the founding
  oCursor = oFound.Text.CreateTextCursorbyRange(oFound)

  ' Find out, which object is to be created...
  FieldStringThere = Instr(1,sFoundContent,"Field")
  ULStringThere = Instr(1,sFoundContent,"UL")
  PHStringThere = Instr(1,sFoundContent,"Placeholder")
  If FieldStringThere = 1 Then
   CreateUserDatafield(oCursor, sFoundContent)
  ElseIf ULStringThere = 1 Then
   CreateBullet(oCursor, oStyles)
  ElseIf PHStringThere = 1 Then
   CreatePlaceholder(oCursor, sFoundContent)
  End If
 Next i

 GENERALERROR:
 If Err <> 0 Then
  Msgbox(sGeneralError,16, GetProductName())
  Resume LETSGO
 End If
 LETSGO:
End Sub


' creates a User - datafield out of a string with the following structure
' "<field:Company>"
Sub CreateUserDatafield(oCursor, sFoundContent as String)
 Dim MaxIndex as Integer
 Dim sFoundList(3)
 Dim oUserfield as Object
 Dim UserInfo as String
 Dim UserIndex as Integer

 oUserfield = oDocAuto.CreateInstance("com.sun.star.text.TextField.ExtendedUser")
 sFoundList() = ArrayoutofString(sFoundContent,":",MaxIndex)
 UserInfo = UCase(LTrim(sFoundList(1)))
 UserIndex = IndexInArray(UserInfo, UserfieldDatatype())
 If UserIndex <> -1 Then
  oUserField.UserDatatype = UserIndex
  oCursor.Text.InsertTextContent(oCursor,oUserField,True)
  oUserField.IsFixed = True
 Else
  Msgbox(UserInfo &": " & sTextFieldNotDefined,16, GetProductName())
 End If
End Sub


' Creates a Bullet by setting a soft Formatation on the first unsorted List-Templates with a defined
' Bullet Id
Sub CreateBullet(oCursor, oStyles as Object)
 Dim n, m, s as Integer
 Dim StyleSet as Boolean
 Dim ostyle as Object
 Dim StyleName as String
 Dim alevel()
 StyleSet = False
 For s = 0 To Ubound(BulletList())
  For n = 0 To oStyles.Count - 1
   ostyle = oStyles.getbyindex(n)
   StyleName = oStyle.Name
   alevel() = ostyle.NumberingRules.getbyindex(0)
   ' The properties of the style are stored in a Name-Value-Array()
   For m = 0 to Ubound(alevel())
    ' Set the first Numbering template without a bulletID
    If (aLevel(m).Name = "BulletId") Then
     If alevel(m).Value = BulletList(s) Then
      oCursor.NumberingStyle = StyleName
      oCursor.SetString("")
      exit Sub
     End if
    End If
   Next m
  Next n
 Next s
 If Not StyleSet Then
  ' The Template with the demanded BulletID is not available, so take the first style in the sequence
  ' that has a defined Bullet ID
  oCursor.NumberingStyleName = oStyles.GetByIndex(5).Name
  oCursor.SetString("")
 End If
End Sub


' Creates a placeholder out of a string with the following structure:
'<placeholder:Showtext:Helptext>
Sub CreatePlaceholder(oCursor as Object, sFoundContent as String)
 Dim oPlaceholder as Object
 Dim MaxIndex as Integer
 Dim sFoundList(3)
 oPlaceholder = oDocAuto.CreateInstance("com.sun.star.text.TextField.JumpEdit")
 sFoundList() = ArrayoutofString(sFoundContent, ":" & chr(34),MaxIndex)
 ' Delete The Double-quotes
 oPlaceholder.Hint = DeleteStr(sFoundList(2),chr(34))
 oPlaceholder.placeholder =  DeleteStr(sFoundList(1),chr(34))
 oCursor.Text.InsertTextContent(oCursor,oPlaceholder,True)
End Sub


</script:module>