Option Explicit Public UserfieldDataType(14) as String Public oDocAuto as Object Public BulletList(7) as Integer 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 ' Initialization... BasicLibraries.LoadLibrary("Tools") 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 = StarDesktop.ActiveFrame.Controller.Model oStyles = oDocAuto.Stylefamilies.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 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 sTextFieldNotDefined as String 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 If InitResources("'Template'", "tpl") Then sTextFieldNotDefined = GetResText(1400) Msgbox(UserInfo &": " & sTextFieldNotDefined,16, GetProductName()) End If 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