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