1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
|
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<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'", "tpl") Then
sGeneralError = GetResText(1302)
sTextFieldNotDefined = GetResText(1400)
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>
|
