1 <?xml version="1.0" encoding="UTF-8"?> 2 <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> 3 <!--*********************************************************** 4 * 5 * Licensed to the Apache Software Foundation (ASF) under one 6 * or more contributor license agreements. See the NOTICE file 7 * distributed with this work for additional information 8 * regarding copyright ownership. The ASF licenses this file 9 * to you under the Apache License, Version 2.0 (the 10 * "License"); you may not use this file except in compliance 11 * with the License. You may obtain a copy of the License at 12 * 13 * http://www.apache.org/licenses/LICENSE-2.0 14 * 15 * Unless required by applicable law or agreed to in writing, 16 * software distributed under the License is distributed on an 17 * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 18 * KIND, either express or implied. See the License for the 19 * specific language governing permissions and limitations 20 * under the License. 21 * 22 ***********************************************************--> 23 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="Autotext" script:language="StarBasic">Option Explicit 24 25 Public UserfieldDataType(14) as String 26 Public oDocAuto as Object 27 Public BulletList(7) as Integer 28 Public sTextFieldNotDefined as String 29 Public sGeneralError as String 30 31 32 Sub Main() 33 Dim oCursor as Object 34 Dim oStyles as Object 35 Dim oSearchDesc as Object 36 Dim oFoundall as Object 37 Dim oFound as Object 38 Dim i as Integer 39 Dim sFoundString as String 40 Dim sFoundContent as String 41 Dim FieldStringThere as String 42 Dim ULStringThere as String 43 Dim PHStringThere as String 44 On Local Error Goto GENERALERROR 45 ' Initialization... 46 BasicLibraries.LoadLibrary("Tools") 47 If InitResources("'Template'", "tpl") Then 48 sGeneralError = GetResText(1302) 49 sTextFieldNotDefined = GetResText(1400) 50 End If 51 52 UserfieldDatatype(0) = "COMPANY" 53 UserfieldDatatype(1) = "FIRSTNAME" 54 UserfieldDatatype(2) = "NAME" 55 UserfieldDatatype(3) = "SHORTCUT" 56 UserfieldDatatype(4) = "STREET" 57 UserfieldDatatype(5) = "COUNTRY" 58 UserfieldDatatype(6) = "ZIP" 59 UserfieldDatatype(7) = "CITY" 60 UserfieldDatatype(8) = "TITLE" 61 UserfieldDatatype(9) = "POSITION" 62 UserfieldDatatype(10) = "PHONE_PRIVATE" 63 UserfieldDatatype(11) = "PHONE_COMPANY" 64 UserfieldDatatype(12) = "FAX" 65 UserfieldDatatype(13) = "EMAIL" 66 UserfieldDatatype(14) = "STATE" 67 BulletList(0) = 149 68 BulletList(1) = 34 69 BulletList(2) = 65 70 BulletList(3) = 61 71 BulletList(4) = 49 72 BulletList(5) = 47 73 BulletList(6) = 79 74 BulletList(7) = 58 75 76 oDocAuto = ThisComponent 77 oStyles = oDocAuto.Stylefamilies.GetByName("NumberingStyles") 78 79 ' Prepare the Search-Descriptor 80 oSearchDesc = oDocAuto.createsearchDescriptor() 81 oSearchDesc.SearchRegularExpression = True 82 oSearchDesc.SearchWords = True 83 oSearchDesc.SearchString = "<[^>]+>" 84 oFoundall = oDocAuto.FindAll(oSearchDesc) 85 86 'Loop over the foundings 87 For i = 0 To oFoundAll.Count - 1 88 oFound = oFoundAll.GetByIndex(i) 89 sFoundString = oFound.String 90 'Extract the string inside the brackets 91 sFoundContent = FindPartString(sFoundString,"<",">",1) 92 sFoundContent = LTrim(sFoundContent) 93 94 ' Define the Cursor and place it on the founding 95 oCursor = oFound.Text.CreateTextCursorbyRange(oFound) 96 97 ' Find out, which object is to be created... 98 FieldStringThere = Instr(1,sFoundContent,"Field") 99 ULStringThere = Instr(1,sFoundContent,"UL") 100 PHStringThere = Instr(1,sFoundContent,"Placeholder") 101 If FieldStringThere = 1 Then 102 CreateUserDatafield(oCursor, sFoundContent) 103 ElseIf ULStringThere = 1 Then 104 CreateBullet(oCursor, oStyles) 105 ElseIf PHStringThere = 1 Then 106 CreatePlaceholder(oCursor, sFoundContent) 107 End If 108 Next i 109 110 GENERALERROR: 111 If Err <> 0 Then 112 Msgbox(sGeneralError,16, GetProductName()) 113 Resume LETSGO 114 End If 115 LETSGO: 116 End Sub 117 118 119 ' creates a User - datafield out of a string with the following structure 120 ' "<field:Company>" 121 Sub CreateUserDatafield(oCursor, sFoundContent as String) 122 Dim MaxIndex as Integer 123 Dim sFoundList(3) 124 Dim oUserfield as Object 125 Dim UserInfo as String 126 Dim UserIndex as Integer 127 128 oUserfield = oDocAuto.CreateInstance("com.sun.star.text.TextField.ExtendedUser") 129 sFoundList() = ArrayoutofString(sFoundContent,":",MaxIndex) 130 UserInfo = UCase(LTrim(sFoundList(1))) 131 UserIndex = IndexinArray(UserInfo, UserfieldDatatype()) 132 If UserIndex <> -1 Then 133 oUserField.UserDatatype = UserIndex 134 oCursor.Text.InsertTextContent(oCursor,oUserField,True) 135 oUserField.IsFixed = True 136 Else 137 Msgbox(UserInfo &": " & sTextFieldNotDefined,16, GetProductName()) 138 End If 139 End Sub 140 141 142 ' Creates a Bullet by setting a soft Formatation on the first unsorted List-Templates with a defined 143 ' Bullet Id 144 Sub CreateBullet(oCursor, oStyles as Object) 145 Dim n, m, s as Integer 146 Dim StyleSet as Boolean 147 Dim ostyle as Object 148 Dim StyleName as String 149 Dim alevel() 150 StyleSet = False 151 For s = 0 To Ubound(BulletList()) 152 For n = 0 To oStyles.Count - 1 153 ostyle = oStyles.getbyindex(n) 154 StyleName = oStyle.Name 155 alevel() = ostyle.NumberingRules.getbyindex(0) 156 ' The properties of the style are stored in a Name-Value-Array() 157 For m = 0 to Ubound(alevel()) 158 ' Set the first Numbering template without a bulletID 159 If (aLevel(m).Name = "BulletId") Then 160 If alevel(m).Value = BulletList(s) Then 161 oCursor.NumberingStyle = StyleName 162 oCursor.SetString("") 163 exit Sub 164 End if 165 End If 166 Next m 167 Next n 168 Next s 169 If Not StyleSet Then 170 ' The Template with the demanded BulletID is not available, so take the first style in the sequence 171 ' that has a defined Bullet ID 172 oCursor.NumberingStyleName = oStyles.GetByIndex(5).Name 173 oCursor.SetString("") 174 End If 175 End Sub 176 177 178 ' Creates a placeholder out of a string with the following structure: 179 '<placeholder:Showtext:Helptext> 180 Sub CreatePlaceholder(oCursor as Object, sFoundContent as String) 181 Dim oPlaceholder as Object 182 Dim MaxIndex as Integer 183 Dim sFoundList(3) 184 oPlaceholder = oDocAuto.CreateInstance("com.sun.star.text.TextField.JumpEdit") 185 sFoundList() = ArrayoutofString(sFoundContent, ":" & chr(34),MaxIndex) 186 ' Delete The Double-quotes 187 oPlaceholder.Hint = DeleteStr(sFoundList(2),chr(34)) 188 oPlaceholder.placeholder = DeleteStr(sFoundList(1),chr(34)) 189 oCursor.Text.InsertTextContent(oCursor,oPlaceholder,True) 190 End Sub 191 192 193 </script:module> 194