?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Version 6.1.4.1, tag libreoffice-6.1.4.1
[LibreOffice.git] / wizards / source / access2base / Application.xba
blob809082690226caaf492d2e10007be19dbdb96349
1 <?xml version="1.0" encoding="UTF-8"?>
2 <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
3 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="Application" script:language="StarBasic">REM =======================================================================================================================
4 REM === The Access2Base library is a part of the LibreOffice project. ===
5 REM === Full documentation is available on http://www.access2base.com ===
6 REM =======================================================================================================================
7
8 Option Explicit
9
10 REM -----------------------------------------------------------------------------------------------------------------------
11 Global Const TRACEDEBUG = &quot;DEBUG&quot; &apos; To report values of variables
12 Global Const TRACEINFO = &quot;INFO&quot; &apos; To report any event
13 Global Const TRACEWARNING = &quot;WARNING&quot; &apos; To report some abnormal event
14 Global Const TRACEERRORS = &quot;ERROR&quot; &apos; To report user errors - Default value
15 Global Const TRACEFATAL = &quot;FATAL&quot; &apos; To report programmer errors - f.i. Wrong argument
16 Global Const TRACEABORT = &quot;ABORT&quot; &apos; To report Access2Base internal errors
17 Global Const TRACEANY = &quot;===&gt;&quot; &apos; Always reported
18 &apos; ERRORs, FATALs and ABORTs are also displayed in a MsgBox (except on specific request)
19 &apos; FATALs and ABORTs interrupt the program execution
20
21 Global Const ERRINIT = 1500
22 Global Const ERRDBNOTCONNECTED = 1501
23 Global Const ERRMISSINGARGUMENTS = 1502
24 Global Const ERRWRONGARGUMENT = 1503
25 Global Const ERRMAINFORM = 1504
26 Global Const ERRMETHOD = 1505
27 Global Const ERRFILEACCESS = 1506
28 Global Const ERRFORMNOTIDENTIFIED = 1507
29 Global Const ERRFORMNOTFOUND = 1508
30 Global Const ERRFORMNOTOPEN = 1509
31 Global Const ERRDFUNCTION = 1510
32 Global Const ERROPENFORM = 1511
33 Global Const ERRPROPERTY = 1512
34 Global Const ERRPROPERTYVALUE = 1513
35 Global Const ERRINDEXVALUE = 1514
36 Global Const ERRCOLLECTION = 1515
37 Global Const ERRPROPERTYNOTARRAY = 1516
38 Global Const ERRCONTROLNOTFOUND = 1517
39 Global Const ERRNOACTIVEFORM = 1518
40 Global Const ERRDATABASEFORM = 1519
41 Global Const ERRFOCUSINGRID = 1520
42 Global Const ERRNOGRIDINFORM = 1521
43 Global Const ERRFINDRECORD = 1522
44 Global Const ERRSQLSTATEMENT = 1523
45 Global Const ERROBJECTNOTFOUND = 1524
46 Global Const ERROPENOBJECT = 1525
47 Global Const ERRCLOSEOBJECT = 1526
48 Global Const ERRMETHOD = 1527
49 Global Const ERRACTION = 1528
50 Global Const ERRSENDMAIL = 1529
51 Global Const ERRFORMYETOPEN = 1530
52 Global Const ERRPROPERTYINIT = 1531
53 Global Const ERRFILENOTCREATED = 1532
54 Global Const ERRDIALOGNOTFOUND = 1533
55 Global Const ERRDIALOGUNDEFINED = 1534
56 Global Const ERRDIALOGSTARTED = 1535
57 Global Const ERRDIALOGNOTSTARTED = 1536
58 Global Const ERRRECORDSETNODATA = 1537
59 Global Const ERRRECORDSETCLOSED = 1538
60 Global Const ERRRECORDSETRANGE = 1539
61 Global Const ERRRECORDSETFORWARD = 1540
62 Global Const ERRFIELDNULL = 1541
63 Global Const ERROVERFLOW = 1542
64 Global Const ERRNOTACTIONQUERY = 1543
65 Global Const ERRNOTUPDATABLE = 1544
66 Global Const ERRUPDATESEQUENCE = 1545
67 Global Const ERRNOTNULLABLE = 1546
68 Global Const ERRROWDELETED = 1547
69 Global Const ERRRECORDSETCLONE = 1548
70 Global Const ERRQUERYDEFDELETED = 1549
71 Global Const ERRTABLEDEFDELETED = 1550
72 Global Const ERRTABLECREATION = 1551
73 Global Const ERRFIELDCREATION = 1552
74 Global Const ERRSUBFORMNOTFOUND = 1553
75 Global Const ERRWINDOW = 1554
76 Global Const ERRCOMPATIBILITY = 1555
77 Global Const ERRPRECISION = 1556
78 Global Const ERRMODULENOTFOUND = 1557
79 Global Const ERRPROCEDURENOTFOUND = 1558
80
81 REM -----------------------------------------------------------------------------------------------------------------------
82 Global Const DBCONNECTBASE = 1 &apos; Connection from Base document (OpenConnection)
83 Global Const DBCONNECTFORM = 2 &apos; Connection from a database-aware form (OpenConnection)
84 Global Const DBCONNECTANY = 3 &apos; Connection from any document for data access only (OpenDatabase)
85
86 REM -----------------------------------------------------------------------------------------------------------------------
87 Global Const DBMS_UNKNOWN = 0
88 Global Const DBMS_HSQLDB1 = 1
89 Global Const DBMS_HSQLDB2 = 2
90 Global Const DBMS_FIREBIRD = 3
91 Global Const DBMS_MSACCESS2003 = 4
92 Global Const DBMS_MSACCESS2007 = 5
93 Global Const DBMS_MYSQL = 6
94 Global Const DBMS_POSTGRES = 7
95 Global Const DBMS_SQLITE = 8
96
97 REM -----------------------------------------------------------------------------------------------------------------------
98 Global Const COLLALLDIALOGS = &quot;ALLDIALOGS&quot;
99 Global Const COLLALLFORMS = &quot;ALLFORMS&quot;
100 Global Const COLLALLMODULES = &quot;ALLMODULES&quot;
101 Global Const COLLCOMMANDBARS = &quot;COMMANDBARS&quot;
102 Global Const COLLCOMMANDBARCONTROLS = &quot;COMMANDBARCONTROLS&quot;
103 Global Const COLLCONTROLS = &quot;CONTROLS&quot;
104 Global Const COLLFORMS = &quot;FORMS&quot;
105 Global Const COLLFIELDS = &quot;FIELDS&quot;
106 Global Const COLLPROPERTIES = &quot;PROPERTIES&quot;
107 Global Const COLLQUERYDEFS = &quot;QUERYDEFS&quot;
108 Global Const COLLRECORDSETS = &quot;RECORDSETS&quot;
109 Global Const COLLTABLEDEFS = &quot;TABLEDEFS&quot;
110 Global Const COLLTEMPVARS = &quot;TEMPVARS&quot;
111
112 REM -----------------------------------------------------------------------------------------------------------------------
113 Global Const OBJAPPLICATION = &quot;APPLICATION&quot;
114 Global Const OBJCOLLECTION = &quot;COLLECTION&quot;
115 Global Const OBJCOMMANDBAR = &quot;COMMANDBAR&quot;
116 Global Const OBJCOMMANDBARCONTROL = &quot;COMMANDBARCONTROL&quot;
117 Global Const OBJCONTROL = &quot;CONTROL&quot;
118 Global Const OBJDATABASE = &quot;DATABASE&quot;
119 Global Const OBJDIALOG = &quot;DIALOG&quot;
120 Global Const OBJEVENT = &quot;EVENT&quot;
121 Global Const OBJFIELD = &quot;FIELD&quot;
122 Global Const OBJFORM = &quot;FORM&quot;
123 Global Const OBJMODULE = &quot;MODULE&quot;
124 Global Const OBJOPTIONGROUP = &quot;OPTIONGROUP&quot;
125 Global Const OBJPROPERTY = &quot;PROPERTY&quot;
126 Global Const OBJQUERYDEF = &quot;QUERYDEF&quot;
127 Global Const OBJRECORDSET = &quot;RECORDSET&quot;
128 Global Const OBJSUBFORM = &quot;SUBFORM&quot;
129 Global Const OBJTABLEDEF = &quot;TABLEDEF&quot;
130 Global Const OBJTEMPVAR = &quot;TEMPVAR&quot;
131
132 REM -----------------------------------------------------------------------------------------------------------------------
133 Global Const CTLCONTROL = &quot;CONTROL&quot; &apos; ClassId
134 Global Const CTLCHECKBOX = &quot;CHECKBOX&quot; &apos; 5
135 Global Const CTLCOMBOBOX = &quot;COMBOBOX&quot; &apos; 7
136 Global Const CTLCOMMANDBUTTON = &quot;COMMANDBUTTON&quot; &apos; 2
137 Global Const CTLCURRENCYFIELD = &quot;CURRENCYFIELD&quot; &apos; 18
138 Global Const CTLDATEFIELD = &quot;DATEFIELD&quot; &apos; 15
139 Global Const CTLFILECONTROL = &quot;FILECONTROL&quot; &apos; 12
140 Global Const CTLFIXEDTEXT = &quot;FIXEDTEXT&quot; &apos; 10
141 Global Const CTLGRIDCONTROL = &quot;GRIDCONTROL&quot; &apos; 11
142 Global Const CTLGROUPBOX = &quot;GROUPBOX&quot; &apos; 8
143 Global Const CTLHIDDENCONTROL = &quot;HIDDENCONTROL&quot; &apos; 13
144 Global Const CTLIMAGEBUTTON = &quot;IMAGEBUTTON&quot; &apos; 4
145 Global Const CTLIMAGECONTROL = &quot;IMAGECONTROL&quot; &apos; 14
146 Global Const CTLLISTBOX = &quot;LISTBOX&quot; &apos; 6
147 Global Const CTLNAVIGATIONBAR = &quot;NAVIGATIONBAR&quot; &apos; 22
148 Global Const CTLNUMERICFIELD = &quot;NUMERICFIELD&quot; &apos; 17
149 Global Const CTLPATTERNFIELD = &quot;PATTERNFIELD&quot; &apos; 19
150 Global Const CTLRADIOBUTTON = &quot;RADIOBUTTON&quot; &apos; 3
151 Global Const CTLSCROLLBAR = &quot;SCROLLBAR&quot; &apos; 20
152 Global Const CTLSPINBUTTON = &quot;SPINBUTTON&quot; &apos; 21
153 Global Const CTLTEXTFIELD = &quot;TEXTFIELD&quot; &apos; 9
154 Global Const CTLTIMEFIELD = &quot;TIMEFIELD&quot; &apos; 16
155 REM -----------------------------------------------------------------------------------------------------------------------
156 Global Const CTLFORMATTEDFIELD = &quot;FORMATTEDFIELD&quot; &apos; 9 (idem TextField)
157 Global Const CTLFIXEDLINE = &quot;FIXEDLINE&quot; &apos; 24 (forced)
158 Global Const CTLPROGRESSBAR = &quot;PROGRESSBAR&quot; &apos; 23 (forced)
159 Global Const CTLSUBFORM = &quot;SUBFORMCONTROL&quot; &apos; None
160 REM -----------------------------------------------------------------------------------------------------------------------
161 Global Const CTLPARENTISFORM = &quot;FORM&quot;
162 Global Const CTLPARENTISDIALOG = &quot;DIALOG&quot;
163 Global Const CTLPARENTISSUBFORM = &quot;SUBFORM&quot;
164 Global Const CTLPARENTISGRID = &quot;GRID&quot;
165 Global Const CTLPARENTISGROUP = &quot;OPTIONGROUP&quot;
166
167 REM -----------------------------------------------------------------------------------------------------------------------
168 Global Const MODDOCUMENT = &quot;DOCUMENT&quot;
169 Global Const MODGLOBAL = &quot;GLOBAL&quot;
170
171 REM -----------------------------------------------------------------------------------------------------------------------
172 Type DocContainer
173 Document As Object &apos; com.sun.star.comp.dba.ODatabaseDocument or SwXTextDocument or ScModelObj
174 Active As Boolean
175 DbConnect As Integer &apos; DBCONNECTxxx constants
176 URL As String
177 DbContainers() As Variant &apos; One entry by (data-aware) form
178 End Type
179
180 Type DbContainer
181 FormName As String &apos; name of data-aware form
182 Database As Object &apos; Database type
183 End Type
184
185 REM -----------------------------------------------------------------------------------------------------------------------
186 Public Function AllDialogs(ByVal Optional pvIndex As Variant) As Variant
187 &apos; Return either a Collection or a Dialog object
188 &apos; The dialogs are selected only if library is loaded
189
190 If _ErrorHandler() Then On Local Error Goto Error_Function
191 Const cstThisSub = &quot;AllDialogs&quot;
192 Utils._SetCalledSub(cstThisSub)
193
194 Dim iMode As Integer, vDialogs() As Variant, i As Integer, j As Integer, iCount As Integer
195 Dim oMacLibraries As Object, vAllDialogs As Variant, oLibrary As Object, vNames() As Variant, bFound As Boolean
196 Dim oLibDialog As Object, sLibrary As String, oDocLibraries As Object, bLocalStorage As Boolean
197 Dim vLibraries() As Variant, vMacLibraries() As Variant, vDocLibraries() As Variant, oDocMacLib As Object
198 Dim vCurrentDocument As Variant
199 Const cstCount = 0
200 Const cstByIndex = 1
201 Const cstByName = 2
202 Const cstSepar = &quot;!&quot;
203
204 If IsMissing(pvIndex) Then
205 iMode = cstCount
206 Else
207 If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function
208 If VarType(pvIndex) = vbString Then iMode = cstByName Else iMode = cstByIndex
209 End If
210
211 Set vAllDialogs = Nothing
212
213 Set vCurrentDocument = _A2B_.CurrentDocument
214 If IsNull(vCurrentDocument) Then
215 Set oDocLibraries = Nothing
216 vDocLibraries = Array()
217 Else
218 Set oDocLibraries = _A2B_.CurrentDocument.Document.DialogLibraries &apos; ThisComponent.DialogLibraries
219 vDocLibraries = oDocLibraries.getElementNames()
220 End If
221 Set oMacLibraries = DialogLibraries
222 vMacLibraries = oMacLibraries.getElementNames()
223 &apos;Remove Access2Base from the list
224 If _A2B_.ExcludeA2B Then
225 For i = 0 To UBound(vMacLibraries)
226 If Left(vMacLibraries(i), 11) = &quot;Access2Base&quot; Then vMacLibraries(i) = &quot;&quot;
227 Next i
228 End If
229 vMacLibraries = Utils._TrimArray(vMacLibraries)
230
231 If UBound(vDocLibraries) + UBound(vMacLibraries) &lt; 0 Then &apos; No library
232 Set vAllDialogs = New Collect
233 vAllDialogs._CollType = COLLALLDIALOGS
234 vAllDialogs._ParentType = OBJAPPLICATION
235 vAllDialogs._ParentName = &quot;&quot;
236 vAllDialogs._Count = 0
237 Goto Exit_Function
238 End If
239
240 vNames = Array()
241 iCount = 0
242 For i = 0 To UBound(vDocLibraries) + UBound(vMacLibraries) + 1
243 bFound = False
244 If i &lt;= UBound(vDocLibraries) Then
245 sLibrary = vDocLibraries(i)
246 bLocalStorage = True
247 Set oDocMacLib = oDocLibraries
248 &apos; Sometimes library not loaded as should ??
249 If Not oDocMacLib.IsLibraryLoaded(sLibrary) Then oDocMacLib.loadLibrary(sLibrary)
250 Else
251 sLibrary = vMacLibraries(i - UBound(vDocLibraries) - 1)
252 bLocalStorage = False
253 Set oDocMacLib = oMacLibraries
254 End If
255 If oDocMacLib.IsLibraryLoaded(sLibrary) Then
256 Set oLibrary = oDocMacLib.getByName(sLibrary)
257 If oLibrary.hasElements() Then
258 vDialogs = oLibrary.getElementNames()
259 Select Case iMode
260 Case cstCount
261 iCount = iCount + UBound(vDialogs) + 1
262 Case cstByIndex, cstByName
263 For j = 0 To UBound(vDialogs)
264 If iMode = cstByIndex Then
265 If pvIndex = iCount Then bFound = True
266 iCount = iCount + 1
267 Else
268 If UCase(pvIndex) = UCase(vDialogs(j)) Then bFound = True
269 End If
270 If bFound Then
271 Set oLibDialog = oLibrary.getByName(vDialogs(j)) &apos; Create Dialog object
272 Exit For
273 End If
274 Next j
275 End Select
276 End If
277 End If
278 If bFound Then Exit For
279 Next i
280
281 If iMode = cstCount Then
282 Set vAllDialogs = New Collect
283 vAllDialogs._CollType = COLLALLDIALOGS
284 vAllDialogs._ParentType = OBJAPPLICATION
285 vAllDialogs._ParentName = &quot;&quot;
286 vAllDialogs._Count = iCount
287 Else
288 If Not bFound Then
289 If iMode = cstByIndex Then Goto Trace_Error_Index Else Goto Trace_Not_Found
290 End If
291 Set vAllDialogs = New Dialog
292 With vAllDialogs
293 ._Name = vDialogs(j)
294 ._Shortcut = &quot;Dialogs!&quot; &amp; vDialogs(j)
295 Set ._Dialog = oLibDialog
296 ._Library = sLibrary
297 ._Storage = Iif(bLocalStorage, &quot;DOCUMENT&quot;, &quot;GLOBAL&quot;)
298 End With
299 End If
300
301 Exit_Function:
302 Set AllDialogs = vAllDialogs
303 Utils._ResetCalledSub(cstThisSub)
304 Exit Function
305 Trace_Not_Found:
306 TraceError(TRACEFATAL, ERRDIALOGNOTFOUND, Utils._CalledSub(), 0, , pvIndex)
307 Goto Exit_Function
308 Trace_Error_Index:
309 TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0, 1)
310 Set vDialogs = Nothing
311 Goto Exit_Function
312 Error_Function:
313 TraceError(TRACEABORT, Err, cstThisSub, Erl)
314 Set vDialogs = Nothing
315 GoTo Exit_Function
316 End Function &apos; AllDialogs V0.9.5
317
318 REM -----------------------------------------------------------------------------------------------------------------------
319 Public Function AllForms(ByVal Optional pvIndex As Variant) As Variant
320 &apos; Return an object of type Form indicated by either its index (integer) or its name (NOT CASE-SENSITIVE string)
321 &apos; Easiest use for standalone forms: AllForms(0)
322 &apos; If no argument, return a Collection type
323
324 If _ErrorHandler() Then On Local Error Goto Error_Function
325 Const cstThisSub = &quot;AllForms&quot;
326 Utils._SetCalledSub(cstThisSub)
327 Dim iIndex As Integer, vAllForms As Variant
328 Set vAllForms = Nothing
329
330 If Not IsMissing(pvIndex) Then
331 If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function
332 Select Case VarType(pvIndex)
333 Case vbString
334 iIndex = -1
335 Case vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal
336 iIndex = pvIndex
337 End Select
338 End If
339
340 Dim iCurrentDoc As Integer, vCurrentDoc As Variant, oForms As Variant, oCounter As Variant, oFormsCollection As Object
341 iCurrentDoc = _A2B_.CurrentDocIndex()
342 If iCurrentDoc &gt;= 0 Then
343 vCurrentDoc = _A2B_.CurrentDocument(iCurrentDoc)
344 Else
345 Goto Exit_Function
346 End If
347 If vCurrentDoc.DbConnect = DBCONNECTBASE Then Set oForms = vCurrentDoc.Document.getFormDocuments()
348 &apos; Process when NO ARGUMENT
349 If IsMissing(pvIndex) Then &apos; No argument
350 Set oCounter = New Collect
351 oCounter._CollType = COLLALLFORMS
352 oCounter._ParentType = OBJAPPLICATION
353 oCounter._ParentName = &quot;&quot;
354 If vCurrentDoc.DbConnect = DBCONNECTFORM Then oCounter._Count = UBound(vCurrentDoc.DbContainers) + 1 Else oCounter._Count = oForms.getCount()
355 Set vAllForms = oCounter
356 Goto Exit_Function
357 End If
358
359 &apos; Process when ARGUMENT = STRING or INDEX =&gt; Initialize form object
360 Dim ofForm As Object
361 Set ofForm = New Form
362 Dim sAllForms As Variant, i As Integer, vName As Variant, oDatabase As Object, bFound As Boolean
363 Select Case vCurrentDoc.DbConnect
364 Case DBCONNECTBASE
365 sAllForms() = oForms.getElementNames()
366 ofForm._DocEntry = 0
367 ofForm._DbEntry = 0
368 If iIndex= -1 Then &apos; String argument
369 vName = Utils._InList(Utils._Trim(pvIndex), sAllForms, True) &apos; hasByName not used because case sensitive
370 If vName = False Then Goto Trace_Not_Found
371 ofForm._Initialize(vName)
372 Else
373 If iIndex + 1 &gt; oForms.getCount() Or iIndex &lt; 0 Then Goto Trace_Error_Index &apos; Numeric argument OK but value nonsense
374 ofForm._Initialize(sAllForms(iIndex))
375 End If
376 Case DBCONNECTFORM
377 With vCurrentDoc
378 If iIndex = -1 Then
379 bFound = False
380 For i = 0 To UBound(vCurrentDoc.DbContainers)
381 Set oDatabase = vCurrentDoc.DbContainers(i).Database
382 If UCase(Utils._Trim(pvIndex)) = UCase(oDatabase.FormName) Then
383 bFound = True
384 ofForm._DbEntry = i
385 Exit For
386 End If
387 Next i
388 If Not bFound Then Goto Trace_Not_Found
389 ElseIf iIndex &lt; 0 Or iIndex &gt; UBound(vCurrentDoc.DbContainers) Then
390 Goto Trace_Error_Index
391 Else
392 ofForm._DbEntry = iIndex
393 Set oDatabase = vCurrentDoc.DbContainers(iIndex).Database
394 End If
395 End With
396 vName = oDatabase.FormName
397 ofForm._DocEntry = iCurrentDoc
398 ofForm._Initialize(vName)
399 End Select
400
401 Set vAllForms = ofForm
402
403 Exit_Function:
404 Set AllForms = vAllForms
405 Utils._ResetCalledSub(cstThisSub)
406 Exit Function
407 Trace_Not_Found:
408 TraceError(TRACEFATAL, ERRFORMNOTFOUND, Utils._CalledSub(), 0, , pvIndex)
409 Goto Exit_Function
410 Trace_Error_Index:
411 TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0, 1)
412 Set vAllForms = Nothing
413 Goto Exit_Function
414 Error_Function:
415 TraceError(TRACEABORT, Err, cstThisSub, Erl)
416 Set vAllForms = Nothing
417 GoTo Exit_Function
418 End Function &apos; AllForms V0.9.0
419
420 REM -----------------------------------------------------------------------------------------------------------------------
421 Public Function AllModules(ByVal Optional pvIndex As Variant, ByVal Optional pbAllModules As Boolean) As Variant
422 &apos; Return either a Collection or a Module object
423 &apos; The modules are selected only if library is loaded
424 &apos; (UNPUBLISHED) pbAllModules = False collects only the modules located in the currently open document
425
426 If _ErrorHandler() Then On Local Error Goto Error_Function
427 Const cstThisSub = &quot;AllModules&quot;
428 Utils._SetCalledSub(cstThisSub)
429
430 Dim iMode As Integer, vModules() As Variant, i As Integer, j As Integer, iCount As Integer
431 Dim oMacLibraries As Object, vAllModules As Variant, oLibrary As Object, vNames() As Variant, bFound As Boolean
432 Dim sScript As String, sLibrary As String, oDocLibraries As Object, sStorage As String
433 Dim vLibraries() As Variant, vMacLibraries() As Variant, vDocLibraries() As Variant, oDocMacLib As Object
434 Const cstCount = 0, cstByIndex = 1, cstByName = 2
435 Const cstDot = &quot;.&quot;
436
437 If IsMissing(pvIndex) Then
438 iMode = cstCount
439 Else
440 If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function
441 If VarType(pvIndex) = vbString Then
442 iMode = cstByName
443 &apos; Determine full name STORAGE.LIBRARY.MODULE
444 vNames = Split(pvIndex, cstDot)
445 If UBound(vNames) = 2 Then
446 ElseIf UBound(vNames) = 1 Then
447 pvIndex = MODDOCUMENT &amp; cstDot &amp; pvIndex
448 ElseIf UBound(vNames) = 0 Then
449 pvIndex = MODDOCUMENT &amp; cstDot &amp; &quot;STANDARD&quot; &amp; cstDot &amp; pvIndex
450 Else
451 GoTo Trace_Not_Found
452 End If
453 Else
454 iMode = cstByIndex
455 End If
456 End If
457
458 If IsMissing(pbAllModules) Then pbAllModules = True
459 If Not Utils._CheckArgument(pbAllModules, 2, vbBoolean) Then Goto Exit_Function
460
461 Set vAllModules = Nothing
462
463 Set oDocLibraries = _A2B_.CurrentDocument.Document.BasicLibraries &apos; ThisComponent.BasicLibraries
464 vDocLibraries = oDocLibraries.getElementNames()
465 If pbAllModules Then
466 Set oMacLibraries = GlobalScope.BasicLibraries
467 vMacLibraries = oMacLibraries.getElementNames()
468 &apos;Remove Access2Base from the list
469 If _A2B_.ExcludeA2B Then
470 For i = 0 To UBound(vMacLibraries)
471 If Left(vMacLibraries(i), 11) = &quot;Access2Base&quot; Then vMacLibraries(i) = &quot;&quot;
472 Next i
473 End If
474 vMacLibraries = Utils._TrimArray(vMacLibraries)
475 End If
476
477 If UBound(vDocLibraries) + UBound(vMacLibraries) &lt; 0 Then &apos; No library
478 Set vAllModules = New Collect
479 vAllModules._CollType = COLLALLMODULES
480 vAllModules._ParentType = OBJAPPLICATION
481 vAllModules._ParentName = &quot;&quot;
482 vAllModules._Count = 0
483 Goto Exit_Function
484 End If
485
486 iCount = 0
487 For i = 0 To UBound(vDocLibraries) + UBound(vMacLibraries) + 1
488 bFound = False
489 If i &lt;= UBound(vDocLibraries) Then
490 sLibrary = vDocLibraries(i)
491 sStorage = MODDOCUMENT
492 Set oDocMacLib = oDocLibraries
493 &apos; Sometimes library not loaded as should ??
494 If Not oDocMacLib.IsLibraryLoaded(sLibrary) Then oDocMacLib.loadLibrary(sLibrary)
495 Else
496 sLibrary = vMacLibraries(i - UBound(vDocLibraries) - 1)
497 sStorage = MODGLOBAL
498 Set oDocMacLib = oMacLibraries
499 End If
500 If oDocMacLib.IsLibraryLoaded(sLibrary) Then
501 Set oLibrary = oDocMacLib.getByName(sLibrary)
502 If oLibrary.hasElements() Then
503 vModules = oLibrary.getElementNames()
504 Select Case iMode
505 Case cstCount
506 iCount = iCount + UBound(vModules) + 1
507 Case cstByIndex, cstByName
508 For j = 0 To UBound(vModules)
509 If iMode = cstByIndex Then
510 If pvIndex = iCount Then bFound = True
511 iCount = iCount + 1
512 Else
513 If UCase(pvIndex) = UCase(sStorage &amp; cstDot &amp; sLibrary &amp; cstDot &amp; vModules(j)) Then bFound = True
514 End If
515 If bFound Then
516 sScript = oLibrary.getByName(vModules(j)) &apos; Initiate Module object
517 iCount = i
518 Exit For
519 End If
520 Next j
521 End Select
522 End If
523 End If
524 If bFound Then Exit For
525 Next i
526
527 If iMode = cstCount Then
528 Set vAllModules = New Collect
529 vAllModules._CollType = COLLALLMODULES
530 vAllModules._ParentType = OBJAPPLICATION
531 vAllModules._ParentName = &quot;&quot;
532 vAllModules._Count = iCount
533 Else
534 If Not bFound Then
535 If iMode = cstByIndex Then Goto Trace_Error_Index Else Goto Trace_Not_Found
536 End If
537 Set vAllModules = New Module
538 vAllModules._Name = vModules(j)
539 vAllModules._LibraryName = sLibrary
540 Set vAllModules._Library = oLibrary
541 vAllModules._Storage = sStorage
542 vAllModules._Script = sScript
543 vAllModules._Initialize()
544 End If
545
546 Exit_Function:
547 Set AllModules = vAllModules
548 Utils._ResetCalledSub(cstThisSub)
549 Exit Function
550 Trace_Not_Found:
551 TraceError(TRACEFATAL, ERRMODULENOTFOUND, Utils._CalledSub(), 0, , pvIndex)
552 Goto Exit_Function
553 Trace_Error_Index:
554 TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0, 1)
555 Set vModules = Nothing
556 Goto Exit_Function
557 Error_Function:
558 TraceError(TRACEABORT, Err, cstThisSub, Erl)
559 Set vModules = Nothing
560 GoTo Exit_Function
561 End Function &apos; AllModules V1.7.0
562
563 REM -----------------------------------------------------------------------------------------------------------------------
564 Public Sub CloseConnection ()
565
566 &apos; Close all connections established by current document to free memory.
567 &apos; - if Base document =&gt; close the one concerned database connection
568 &apos; - if non-Base documents =&gt; close the connections of each individual standalone form
569
570 If IsEmpty(_A2B_) Then Goto Exit_Sub
571
572 Const cstThisSub = &quot;CloseConnection&quot;
573 Utils._SetCalledSub(cstThisSub)
574
575 Call _A2B_.CloseConnection()
576
577 Exit_Sub:
578 Utils._ResetCalledSub(cstThisSub)
579 Exit Sub
580 End Sub &apos; CloseConnection V1.2.0
581
582 REM -----------------------------------------------------------------------------------------------------------------------
583 Public Function CommandBars(Optional ByVal pvIndex As Variant, Optional ByRef poWindow As Object) As Variant
584 &apos; Return an object of type CommandBar indicated by its index or its name (CASE-INSENSITIVE string)
585 &apos; If no pvIndex argument, return a Collection type
586 &apos; (Unpublished) With poWindow, force the frame in which toolbars are detected
587
588 If _ErrorHandler() Then On Local Error Goto Error_Function
589 Const cstThisSub = &quot;CommandBars&quot;
590 Utils._SetCalledSub(cstThisSub)
591
592 Dim iObjectsCount As Integer, sObjectName As String, oObject As Object
593 Dim oWindow As Object, iWindowType As Integer
594 Dim i As Integer, j As Integer, k As Integer, bFound As Boolean
595 Dim sSupportedModules() As Variant, vModules() As Variant, oModuleUI As Object
596 Dim oToolbar As Object, sToolbarName As String, vUIElements() As Variant, sToolbarFullName As String, iBuiltin As Integer
597
598 Const cstCustom = &quot;CUSTOM&quot;
599
600 Set oObject = Nothing
601 If Not IsMissing(pvIndex) Then
602 If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function
603 End If
604
605 iObjectsCount = 0
606 bFound = False
607
608 If IsMissing(poWindow) Then Set oWindow = _SelectWindow() Else Set oWindow = poWindow
609 If IsNull(oWindow.Frame) Then Goto Trace_WindowError
610
611 &apos; List of 21 modules
612 vModules = CreateUnoService(&quot;com.sun.star.frame.ModuleManager&quot;).getElementNames()
613
614 iWindowType = oWindow.WindowType
615 Select Case iWindowType &apos; Supported window types only
616 Case acForm
617 sSupportedModules = Array( &quot;com.sun.star.sdb.FormDesign&quot; )
618 Case acBasicIDE
619 sSupportedModules = Array( &quot;com.sun.star.script.BasicIDE&quot; )
620 Case acDatabaseWindow
621 sSupportedModules = Array( &quot;com.sun.star.sdb.OfficeDatabaseDocument&quot; )
622 Case acReport
623 sSupportedModules = Array( &quot;com.sun.star.sdb.TextReportDesign&quot; )
624 Case acDocument
625 Select Case oWindow.DocumentType
626 Case docCalc : sSupportedModules = Array( &quot;com.sun.star.sheet.SpreadsheetDocument&quot; )
627 Case docWriter : sSupportedModules = Array( &quot;com.sun.star.text.TextDocument&quot; )
628 Case docImpress : sSupportedModules = Array( &quot;com.sun.star.presentation.PresentationDocument&quot; )
629 Case docDraw : sSupportedModules = Array( &quot;com.sun.star.drawing.DrawingDocument&quot; )
630 Case docMath : sSupportedModules = Array( &quot;com.sun.star.formula.FormulaProperties&quot; )
631 Case Else : sSupportedModules = Array()
632 End Select
633 Case acTable, acQuery
634 sSupportedModules = Array( &quot;com.sun.star.sdb.DataSourceBrowser&quot; _
635 , &quot;com.sun.star.sdb.TableDataView&quot; _
636 )
637 Case acDiagram
638 sSupportedModules = Array( &quot;com.sun.star.sdb.RelationDesign&quot; )
639 Case acWelcome
640 sSupportedModules = Array( &quot;com.sun.star.frame.StartModule&quot; )
641 Case Else
642 sSupportedModules = Array()
643 End Select
644
645 &apos; Find all standard and custom toolbars stored in LibO/AOO Base
646 Set oModuleUI = CreateUnoService(&quot;com.sun.star.ui.ModuleUIConfigurationManagerSupplier&quot;)
647 For k = 0 To UBound(vModules)
648 For j = 0 To UBound(sSupportedModules)
649 iBuiltin = 1 &apos; Default = builtin
650 If vModules(k) = sSupportedModules(j) Then &apos; Supported modules only
651 Set oToolbar = oModuleUI.getUIConfigurationManager(vModules(k))
652 vUIElements() = oToolbar.getUIElementsInfo(0)
653 For i = 0 To UBound(vUIElements)
654 sToolbarFullName = _GetPropertyValue(vUIElements(i), &quot;ResourceURL&quot;)
655 sToolbarName = Split(sToolbarFullName, &quot;/&quot;)(2)
656 If _IsLeft(UCase(sToolbarName), UCase(cstCustom)) Then
657 sToolbarName = _GetPropertyValue(vUIElements(i), &quot;UIName&quot;)
658 iBuiltin = 2
659 End If
660
661 iObjectsCount = iObjectsCount + 1
662 Select Case True
663 Case IsMissing(pvIndex)
664 Case VarType(pvIndex) = vbString
665 If UCase(pvIndex) = UCase(sToolbarName) Then bFound = True
666 Case Else
667 If pvIndex &lt; 0 Then Goto Trace_IndexError
668 If pvIndex = iObjectsCount - 1 Then bFound = True
669 End Select
670
671 If bFound Then
672 Set oObject = _NewCommandBar(vModules(k), sToolbarName, sToolbarFullName, iBuiltin)
673 Set oObject._Window = oWindow.Frame
674 Set oObject._Toolbar = oToolbar
675 Goto Exit_Function
676 End If
677 Next i
678 End If
679 Next j
680 Next k
681
682 &apos; Find all (not builtin) toolbars stored in current document (typically forms)
683 iBuiltin = 3 &apos; Stored in form itself
684 Set oToolbar = oWindow.Frame.Controller.Model.getUIConfigurationManager
685 vUIElements() = oToolbar.getUIElementsInfo(0)
686 For i = 0 To UBound(vUIElements)
687 sToolbarFullName = _GetPropertyValue(vUIElements(i), &quot;ResourceURL&quot;)
688 sToolbarName = _GetPropertyValue(vUIElements(i), &quot;UIName&quot;)
689 iObjectsCount = iObjectsCount + 1
690 Select Case True
691 Case IsMissing(pvIndex)
692 Case VarType(pvIndex) = vbString
693 If UCase(pvIndex) = UCase(sToolbarName) Then bFound = True
694 Case Else
695 If pvIndex = iObjectsCount - 1 Then bFound = True
696 End Select
697 If bFound Then
698 Set oObject = _NewCommandBar(&quot;&quot;, sToolbarName, sToolbarFullName, iBuiltin)
699 Set oObject._Window = oWindow.Frame
700 Set oObject._Toolbar = oToolbar
701 Goto Exit_Function
702 End If
703 Next i
704
705 &apos; MISSING : CUSTOM POPUPS &lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;
706
707 Select Case True
708 Case IsMissing(pvIndex)
709 Set oObject = New Collect
710 oObject._CollType = COLLCOMMANDBARS
711 oObject._ParentType = OBJAPPLICATION
712 oObject._Count = iObjectsCount
713 Case VarType(pvIndex) = vbString
714 Goto Trace_NotFound
715 Case Else &apos; pvIndex is numeric
716 Goto Trace_IndexError
717 End Select
718
719 Exit_Function:
720 Set CommandBars = oObject
721 Set oObject = Nothing
722 Utils._ResetCalledSub(cstThisSub)
723 Exit Function
724 Error_Function:
725 TraceError(TRACEABORT, Err, cstThisSub, Erl)
726 GoTo Exit_Function
727 Trace_NotFound:
728 TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel(&quot;COMMANDBAR&quot;), pvIndex))
729 Goto Exit_Function
730 Trace_IndexError:
731 TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0)
732 Goto Exit_Function
733 Trace_WindowError:
734 TraceError(TRACEFATAL, ERRWINDOW, Utils._CalledSub(), 0)
735 Goto Exit_Function
736 End Function &apos; CommandBars V1,3,0
737
738 REM -----------------------------------------------------------------------------------------------------------------------
739 Public Function Controls(ByVal Optional pvObject As Variant, Optional ByVal pvIndex As Variant) As Variant
740 &apos; Return an object of type Control indicated by either its index (integer) or its name (CASE-INSENSITIVE string)
741 &apos; The 1st argument pvObject can be either
742 &apos; an object of type FORM (1)
743 &apos; a main form name as string
744 &apos; an object of type SUBFORM (2)
745 &apos; The Form property in the returned variant contains a SUBFORM type
746 &apos; an object of type CONTROL and subtype GRIDCONTROL (3)
747 &apos; an object of type OPTIONGROUP (4) 2nd argument, if any, must be numeric
748 &apos; If no pvIndex argument, return a Collection type
749
750 If _ErrorHandler() Then On Local Error Goto Error_Function
751 Dim vObject As Object
752 Const cstThisSub = &quot;Controls&quot;
753 Utils._SetCalledSub(cstThisSub)
754
755 If IsMissing(pvObject) Then Call _TraceArguments()
756 If IsNull(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments()
757 Controls = EMPTY
758
759 If VarType(pvObject) = vbString Then
760 Set vObject = Forms(pvObject)
761 If IsNull(vObject) Then Goto Exit_Function
762 Else
763 If Not Utils._CheckArgument(pvObject, 1, Array(OBJFORM, OBJSUBFORM, OBJOPTIONGROUP, CTLGRIDCONTROL)) Then Goto Exit_Function
764 Set vObject = pvObject
765 End If
766
767 If IsMissing(pvIndex) Then
768 Controls = vObject.Controls()
769 Else
770 If Not Utils._CheckArgument(pvIndex, 2, Utils._AddNumeric(vbString)) Then Goto Exit_Function
771 Controls = vObject.Controls(pvIndex)
772 End If
773
774 Exit_Function:
775 Utils._ResetCalledSub(cstThisSub)
776 Exit Function
777 Error_Function:
778 TraceError(TRACEERROR, Err, cstThisSub, Erl)
779 GoTo Exit_Function
780 End Function &apos; Controls V0.9.0
781
782 REM -----------------------------------------------------------------------------------------------------------------------
783 Public Function CurrentDb() As Object
784 &apos; Returns _A2B_.CurrentDocument().Database as an object to allow access to its properties
785
786 Const cstThisSub = &quot;CurrentDb&quot;
787 Utils._SetCalledSub(cstThisSub)
788
789 Set CurrentDb = Nothing
790 If IsEmpty(_A2B_) Then GoTo Exit_Function
791 Set CurrentDb = _A2B_.CurrentDb()
792
793 Exit_Function:
794 Utils._ResetCalledSub(cstThisSub)
795 Exit Function
796 End Function &apos; CurrentDb V1.1.0
797
798 REM -----------------------------------------------------------------------------------------------------------------------
799 Public Function CurrentUser() As String
800
801 Const cstWindows = 1
802 Const cstUnix = 4
803 Select Case GetGuiType()
804 Case cstWindows
805 CurrentUser = Environ(&quot;USERNAME&quot;)
806 Case cstUnix
807 CurrentUser = Environ(&quot;USER&quot;)
808 Case Else
809 CurrentUser = &quot;&quot;
810 End Select
811
812 End Function &apos; CurrentUser V0.9.1
813
814 REM -----------------------------------------------------------------------------------------------------------------------
815 Public Function DAvg( _
816 ByVal Optional psExpr As String _
817 , ByVal Optional psDomain As String _
818 , ByVal Optional pvCriteria As Variant _
819 ) As Variant
820 &apos; Return average of scope
821 Const cstThisSub = &quot;DAvg&quot;
822 Utils._SetCalledSub(cstThisSub)
823 If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments()
824 DAvg = Application._CurrentDb()._DFunction(&quot;AVG&quot;, psExpr, psDomain, Iif(IsMissing(pvCriteria), &quot;&quot;, pvCriteria), &quot;&quot;)
825 Utils._ResetCalledSub(cstThisSub)
826 End Function &apos; DAvg
827
828 REM -----------------------------------------------------------------------------------------------------------------------
829 Public Function DCount( _
830 ByVal Optional psExpr As String _
831 , ByVal Optional psDomain As String _
832 , ByVal Optional pvCriteria As Variant _
833 ) As Variant
834 &apos; Return # of occurrences of scope
835 Const cstThisSub = &quot;DCount&quot;
836 Utils._SetCalledSub(cstThisSub)
837 If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments()
838 DCount = Application._CurrentDb()._DFunction(&quot;COUNT&quot;, psExpr, psDomain, Iif(IsMissing(pvCriteria), &quot;&quot;, pvCriteria), &quot;&quot;)
839 Utils._ResetCalledSub(cstThisSub)
840 End Function &apos; DCount
841
842 REM -----------------------------------------------------------------------------------------------------------------------
843 Public Function DLookup( _
844 ByVal Optional psExpr As String _
845 , ByVal Optional psDomain As String _
846 , ByVal Optional pvCriteria As Variant _
847 , ByVal Optional pvOrderClause As Variant _
848 ) As Variant
849
850 &apos; Return a value within a table
851 &apos;Arguments: psExpr: an SQL expression
852 &apos; psDomain: a table- or queryname
853 &apos; pvCriteria: an optional WHERE clause
854 &apos; pcOrderClause: an optional order clause incl. &quot;DESC&quot; if relevant
855 &apos;Return: Value of the psExpr if found, else Null.
856 &apos;Author: inspired from Allen Browne. http://allenbrowne.com/ser-42.html
857 &apos;Examples:
858 &apos; 1. To find the last value, include DESC in the OrderClause, e.g.:
859 &apos; DLookup(&quot;[Surname] &amp; [FirstName]&quot;, &quot;tblClient&quot;, , &quot;ClientID DESC&quot;)
860 &apos; 2. To find the lowest non-null value of a field, use the Criteria, e.g.:
861 &apos; DLookup(&quot;ClientID&quot;, &quot;tblClient&quot;, &quot;Surname Is Not Null&quot; , &quot;Surname&quot;)
862
863 Const cstThisSub = &quot;DLookup&quot;
864 Utils._SetCalledSub(cstThisSub)
865 If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments()
866 DLookup = Application._CurrentDb()._DFunction(&quot;&quot;, psExpr, psDomain _
867 , Iif(IsMissing(pvCriteria), &quot;&quot;, pvCriteria) _
868 , Iif(IsMissing(pvOrderClause), &quot;&quot;, pvOrderClause) _
869 )
870 Utils._ResetCalledSub(cstThisSub)
871 End Function &apos; DLookup
872
873 REM -----------------------------------------------------------------------------------------------------------------------
874 Public Function DMax( _
875 ByVal Optional psExpr As String _
876 , ByVal Optional psDomain As String _
877 , ByVal Optional pvCriteria As Variant _
878 ) As Variant
879 &apos; Return maximum of scope
880 Const cstThisSub = &quot;DMax&quot;
881 Utils._SetCalledSub(cstThisSub)
882 If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments()
883 DMax = Application._CurrentDb()._DFunction(&quot;MAX&quot;, psExpr, psDomain, Iif(IsMissing(pvCriteria), &quot;&quot;, pvCriteria), &quot;&quot;)
884 Utils._ResetCalledSub(cstThisSub)
885 End Function &apos; DMax
886
887 REM -----------------------------------------------------------------------------------------------------------------------
888 Public Function DMin( _
889 ByVal Optional psExpr As String _
890 , ByVal Optional psDomain As String _
891 , ByVal Optional pvCriteria As Variant _
892 ) As Variant
893 &apos; Return minimum of scope
894 Const cstThisSub = &quot;DMin&quot;
895 Utils._SetCalledSub(cstThisSub)
896 If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments()
897 DMin = Application._CurrentDb()._DFunction(&quot;MIN&quot;, psExpr, psDomain, Iif(IsMissing(pvCriteria), &quot;&quot;, pvCriteria), &quot;&quot;)
898 Utils._ResetCalledSub(cstThisSub)
899 End Function &apos; DMin
900
901 REM -----------------------------------------------------------------------------------------------------------------------
902 Public Function DStDev( _
903 ByVal Optional psExpr As String _
904 , ByVal Optional psDomain As String _
905 , ByVal Optional pvCriteria As Variant _
906 ) As Variant
907 &apos; Return standard deviation of scope
908 Const cstThisSub = &quot;DStDev&quot;
909 Utils._SetCalledSub(cstThisSub)
910 If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments()
911 DStDev = Application._CurrentDb()._DFunction(&quot;STDDEV_SAMP&quot;, psExpr, psDomain, Iif(IsMissing(pvCriteria), &quot;&quot;, pvCriteria), &quot;&quot;) &apos; STDDEV not STDEV !
912 Utils._ResetCalledSub(cstThisSub)
913 End Function &apos; DStDev
914
915 REM -----------------------------------------------------------------------------------------------------------------------
916 Public Function DStDevP( _
917 ByVal Optional psExpr As String _
918 , ByVal Optional psDomain As String _
919 , ByVal Optional pvCriteria As Variant _
920 ) As Variant
921 &apos; Return standard deviation of scope
922 Const cstThisSub = &quot;DStDevP&quot;
923 Utils._SetCalledSub(cstThisSub)
924 If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments()
925 DStDevP = Application._CurrentDb()._DFunction(&quot;STDDEV_POP&quot;, psExpr, psDomain, Iif(IsMissing(pvCriteria), &quot;&quot;, pvCriteria), &quot;&quot;) &apos; STDDEV not STDEV !
926 Utils._ResetCalledSub(cstThisSub)
927 End Function &apos; DStDevP
928
929 REM -----------------------------------------------------------------------------------------------------------------------
930 Public Function DSum( _
931 ByVal Optional psExpr As String _
932 , ByVal Optional psDomain As String _
933 , ByVal Optional pvCriteria As Variant _
934 ) As Variant
935 &apos; Return sum of scope
936 Const cstThisSub = &quot;DSum&quot;
937 Utils._SetCalledSub(cstThisSub)
938 If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments()
939 DSum = Application._CurrentDb()._DFunction(&quot;SUM&quot;, psExpr, psDomain, Iif(IsMissing(pvCriteria), &quot;&quot;, pvCriteria), &quot;&quot;)
940 Utils._ResetCalledSub(cstThisSub)
941 End Function &apos; DSum
942
943 REM -----------------------------------------------------------------------------------------------------------------------
944 Public Function DVar( _
945 ByVal Optional psExpr As String _
946 , ByVal Optional psDomain As String _
947 , ByVal Optional pvCriteria As Variant _
948 ) As Variant
949 &apos; Return variance of scope
950 Const cstThisSub = &quot;DVar&quot;
951 Utils._SetCalledSub(cstThisSub)
952 If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments()
953 DVar = Application._CurrentDb()._DFunction(&quot;VAR_SAMP&quot;, psExpr, psDomain, Iif(IsMissing(pvCriteria), &quot;&quot;, pvCriteria), &quot;&quot;)
954 Utils._ResetCalledSub(cstThisSub)
955 End Function &apos; DVar
956
957 REM -----------------------------------------------------------------------------------------------------------------------
958 Public Function DVarP( _
959 ByVal Optional psExpr As String _
960 , ByVal Optional psDomain As String _
961 , ByVal Optional pvCriteria As Variant _
962 ) As Variant
963 &apos; Return variance of scope
964 Const cstThisSub = &quot;DVarP&quot;
965 Utils._SetCalledSub(cstThisSub)
966 If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments()
967 DVarP = Application._CurrentDb()._DFunction(&quot;VAR_POP&quot;, psExpr, psDomain, Iif(IsMissing(pvCriteria), &quot;&quot;, pvCriteria), &quot;&quot;)
968 Utils._ResetCalledSub(cstThisSub)
969 End Function &apos; DVarP
970
971 REM -----------------------------------------------------------------------------------------------------------------------
972 Public Function Events(Optional poEvent As Variant) As Variant
973 &apos; Return an event object corresponding with actual event
974
975 Dim vEvent As Variant
976 If _ErrorHandler() Then On Local Error Goto Error_Function
977 Const cstThisSub = &quot;Events&quot;
978 Utils._SetCalledSub(cstThisSub)
979
980 Set vEvent = Nothing
981 If IsMissing(poEvent) Then Goto Exit_Function
982 If IsNull(poEvent) Then Goto Exit_Function
983
984 If Not Utils._CheckArgument(poEvent, 1, vbObject, , False) Then Goto Exit_Function &apos; No error handling in CheckArgument
985 If Not Utils._hasUNOProperty(poEvent, &quot;Source&quot;) Then Goto Trace_Error
986 Set vEvent = New Event
987 vEvent._Initialize(poEvent)
988
989 Exit_Function:
990 Set Events = vEvent
991 Utils._ResetCalledSub(cstThisSub)
992 Exit Function
993 Error_Function:
994 TraceError(TRACEWARNING, Err, cstThisSub, Erl)
995 GoTo Exit_Function
996 Trace_Error:
997 &apos; Errors are not displayed to avoid display infinite cycling
998 TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, False, Array(1, Utils._CStr(poEvent)))
999 Set vEvent = Nothing
1000 Goto Exit_Function
1001 End Function &apos; Events V0.9.1
1002
1003 REM -----------------------------------------------------------------------------------------------------------------------
1004 Public Function Forms(ByVal Optional pvIndex As Variant) As Variant
1005 &apos; Return an object of type Form indicated by either its index (integer) or its name (NOT CASE-SENSITIVE string)
1006 &apos; The concerned form must be loaded.
1007 &apos; If no argument, return a Collection type
1008
1009 Const cstThisSub = &quot;Forms&quot;
1010 Utils._SetCalledSub(cstThisSub)
1011 If _ErrorHandler() Then On Local Error Goto Error_Function
1012
1013 Dim ofForm As Object, oCounter As Variant, vForms As Variant, oIndex As Object
1014 Set vForms = Nothing
1015
1016 Dim iCount As Integer
1017 If IsMissing(pvIndex) Then
1018 iCount = Application._CountOpenForms()
1019 Set oCounter = New Collect
1020 oCounter._CollType = COLLFORMS
1021 oCounter._ParentType = OBJAPPLICATION
1022 oCounter._ParentName = &quot;&quot;
1023 oCounter._Count = iCount
1024 Forms = oCounter
1025 Exit Function
1026 Else
1027 If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function
1028 End If
1029
1030 Select Case VarType(pvIndex)
1031 Case vbString
1032 Set ofForm = Application.AllForms(Utils._Trim(pvIndex))
1033 Case vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal
1034 iCount = Application._CountOpenForms()
1035 If iCount &lt;= pvIndex Then Goto Trace_Error_Index
1036 Set ofForm = Application._CountOpenForms(pvIndex)
1037 Case Else
1038 End Select
1039
1040 If IsNull(ofForm) Then Goto Trace_Error
1041 If ofForm.IsLoaded Then
1042 Set vForms = ofForm
1043 Else
1044 Set vForms = Nothing
1045 TraceError(TRACEFATAL, ERRFORMNOTOPEN, Utils._CalledSub(), 0, , ofForm._Name)
1046 Goto Exit_Function
1047 End If
1048
1049 Exit_Function:
1050 Set Forms = vForms
1051 Utils._ResetCalledSub(cstThisSub)
1052 Exit Function
1053 Trace_Error:
1054 TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, , Array(1, pvIndex))
1055 Set vForms = Nothing
1056 Goto Exit_Function
1057 Trace_Error_Index:
1058 TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0, 1)
1059 Set vForms = Nothing
1060 Goto Exit_Function
1061 Error_Function:
1062 TraceError(TRACEABORT, Err, cstThisSub, Erl)
1063 GoTo Exit_Function
1064 End Function &apos; Forms V0.9.0
1065
1066 REM -----------------------------------------------------------------------------------------------------------------------
1067 Function HtmlEncode(ByVal pvString As Variant, ByVal Optional pvLength As Variant) As String
1068 &apos; Converts a string to an HTML-encoded string.
1069
1070 If _ErrorHandler() Then On Local Error Goto Error_Function
1071 Const cstThisSub = &quot;HtmlEncode&quot;
1072 Utils._SetCalledSub(cstThisSub)
1073
1074 HtmlEncode = &quot;&quot;
1075
1076 Dim sOutput As String, l As Long, lLength As Long
1077 If IsMissing(pvLength) Then pvLength = 0
1078 If Not Utils._CheckArgument(pvString, 1, vbString) Then Goto Exit_Function
1079 If Not Utils._CheckArgument(pvLength, 1, _AddNumeric()) Then Goto Exit_Function
1080
1081 sOutput = &quot;&quot;
1082 lLength = CLng(pvLength)
1083 If Len(pvString) &gt; 0 Then
1084 For l = 1 To Len(pvString)
1085 If lLength &gt; 0 And Len(sOutput) &gt; lLength Then Exit For
1086 sOutput = sOutput &amp; Utils._UTF8Encode(Mid(pvString, l, 1))
1087 Next l
1088 End If
1089
1090 HtmlEncode = sOutput
1091
1092 Exit_Function:
1093 Utils._ResetCalledSub(cstThisSub)
1094 Exit Function
1095 Error_Function:
1096 TraceError(TRACEABORT, Err, cstThisSub, Erl)
1097 GoTo Exit_Function
1098 End Function &apos; HtmlEncode V1.4.0
1099
1100 REM -----------------------------------------------------------------------------------------------------------------------
1101 Public Function OpenConnection ( _
1102 Optional pvComponent As Variant _
1103 , ByVal Optional pvUser As Variant _
1104 , ByVal Optional pvPassword As Variant _
1105 ) As Object
1106
1107 &apos; Establish connection with the database designated in the currently open front-end (.odb) document
1108 &apos; Call template:
1109 &apos; Call OpenConnection(ThisDatabaseDocument[, &quot;&quot;, &quot;&quot;])
1110 &apos; Call stored in the OpenDocument event of the front-end database document
1111 &apos;OR
1112 &apos; Initiates processing of a (standalone ?) Writer, Calc, ... document with 1 or more data-aware forms
1113 &apos; Call template:
1114 &apos; Call OpenConnection(ThisComponent[, &quot;&quot;, &quot;&quot;])
1115 &apos; Call stored in the OpenDocument event of the document
1116 &apos;
1117 &apos; User and Password arguments are obsolete (still tolerated)
1118 &apos; - because no mean has been found to connect protected db from .odb via API
1119 &apos; - because having multiple forms with multiple db&apos;s and multiple passwords is meaningless
1120
1121 Dim oComponent As Object, oForms As Object, iCurrent As Integer
1122 Dim i As Integer, bFound As Boolean
1123 Dim vCurrentDoc() As Variant
1124 Dim oBaseContext As Object, sDbNames() As String, oBaseSource As Object
1125 Dim sDatabaseURL As String, oHandler As Object
1126 Dim vDbContainer As Variant, vDbContainers() As Variant, vDocContainer As Variant
1127 Dim sFormName As String
1128
1129 If IsEmpty(_A2B_) Then Call Application._RootInit() &apos; First use of Access2Base in current AOO/LibO session
1130 Set OpenConnection = Nothing
1131
1132 If _ErrorHandler() Then On Local Error Goto Error_Function
1133 Const cstThisSub = &quot;OpenConnection&quot;
1134 Utils._SetCalledSub(cstThisSub)
1135 If IsMissing(pvComponent) Then Call _TraceArguments()
1136 If Not Utils._CheckArgument(pvComponent, 1, vbObject) Then Goto Exit_Function
1137 Set oComponent = pvComponent
1138 If Not Utils._hasUNOProperty(oComponent, &quot;ImplementationName&quot;) Then
1139 TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, 1, Array(1, oComponent))
1140 Exit Function
1141 End If
1142 If IsMissing(pvUser) Then pvUser = &quot;&quot;
1143 If IsMissing(pvPassword) Then pvPassword = &quot;&quot;
1144 If Not Utils._CheckArgument(pvUser, 2, vbString) Then Goto Exit_Function
1145 If Not Utils._CheckArgument(pvPassword, 3, vbString) Then Goto Exit_Function
1146
1147 If Not IsArray(_A2B_.CurrentDoc) Then
1148 vCurrentDoc() = Array()
1149 Redim vCurrentDoc(0 To 0) &apos; Create at least one entry for database document
1150 Else
1151 vCurrentDoc() = _A2B_.CurrentDoc()
1152 End If
1153
1154 &apos; Find index of entry to use for new connection
1155 With oComponent
1156 Select Case .ImplementationName
1157 Case &quot;com.sun.star.comp.dba.ODatabaseDocument&quot;
1158 iCurrent = 0
1159 Case Else &apos; &quot;SwXTextDocument&quot;, &quot;ScModelObj&quot;
1160 If UBound(vCurrentDoc) &lt;= 0 Then &apos; First Calc or Writer during current session
1161 iCurrent = 1
1162 Else &apos; Search entry already used earlier by same component
1163 bFound = False
1164 For i = 1 To UBound(vCurrentDoc)
1165 If Not IsEmpty(vCurrentDoc(i)) Then
1166 If vCurrentDoc(i).Active And vCurrentDoc(i).URL = .URL Then
1167 iCurrent = i
1168 bFound = True
1169 Exit For
1170 End If
1171 End If
1172 Next i
1173 End If
1174 If Not bFound Then
1175 iCurrent = UBound(vCurrentDoc) + 1 &apos; No entry found, increment array
1176 ReDim Preserve vCurrentDoc(0 To iCurrent)
1177 End If
1178 End Select
1179 End With
1180
1181 &apos; Initialize future entry
1182 Set vDocContainer = New DocContainer
1183 Set vDocContainer.Document = oComponent
1184 vDocContainer.Active = True
1185 vDocContainer.URL = oComponent.URL
1186 &apos; Initialize each DbContainer entry
1187 vDbContainers() = Array()
1188 TraceLog(TRACEANY, Utils._GetProductName() &amp; &quot; - &quot; &amp; Application.ProductCode(), False)
1189 Select Case oComponent.ImplementationName
1190 Case &quot;com.sun.star.comp.dba.ODatabaseDocument&quot; &apos; Ignore pvUser and pvPassword arguments
1191 vDbContainer = New DbContainer
1192 vDbContainer.FormName = &quot;&quot;
1193 Set vDbContainer.Database = New Database
1194 Set vDbContainer.Database._This = vDbContainer.Database
1195 With vDbContainer.Database
1196 If Not oComponent.CurrentController.IsConnected Then
1197 Set oHandler = createUnoService(&quot;com.sun.star.sdb.InteractionHandler&quot;)
1198 Set .Connection = oComponent.DataSource.connectWithCompletion(oHandler)
1199 oComponent.CurrentController.connect()
1200 Else
1201 Set .Connection = oComponent.CurrentController.ActiveConnection
1202 End If
1203 vDocContainer.DbConnect = DBCONNECTBASE
1204 ._DbConnect = DBCONNECTBASE
1205 Set .MetaData = .Connection.MetaData
1206 ._LoadMetadata()
1207 If .MetaData.DatabaseProductName = &quot;MySQL&quot; Then
1208 ._ReadOnly = .MetaData.isReadOnly()
1209 Else
1210 ._ReadOnly = .Connection.isReadOnly() &apos; Always True in Mysql ??
1211 End If
1212 Set .Document = oComponent
1213 .Title = oComponent.Title
1214 .URL = vDocContainer.URL
1215 ReDim vDbContainers(0 To 0)
1216 Set vDbContainers(0) = vDbContainer
1217 TraceLog(TRACEANY, .Version, False)
1218 TraceLog(TRACEANY, UCase(cstThisSub) &amp; &quot; &quot; &amp; .URL, False)
1219 End With
1220 Case Else
1221 Set oForms = oComponent.CurrentController.Model.DrawPage.Forms
1222 If oForms.Count &lt; 1 Then Goto Error_MainForm
1223 ReDim vDbContainers(0 To oForms.Count - 1)
1224 For i = 0 To oForms.Count - 1
1225 vDbContainer = New DbContainer &apos; To make distinct entries !!
1226 sFormName = oForms.ElementNames(i)
1227 Set vDbContainer.Database = New Database
1228 Set vDbContainer.Database._This = vDbContainer.Database
1229 With vDbContainer.Database
1230 .FormName = sFormName
1231 vDbContainer.FormName = sFormName
1232 Set .Form = oForms.getByName(sFormName)
1233 Set .Connection = .Form.ActiveConnection &apos; Might be Nothing in Windows at AOO/LO startup (not met in Linux)
1234 If Not IsNull(.Connection) Then
1235 Set .MetaData = .Connection.MetaData
1236 ._LoadMetadata()
1237 ._ReadOnly = .Connection.isReadOnly()
1238 TraceLog(TRACEANY, .MetaData.getDatabaseProductName() &amp; &quot; &quot; &amp; .MetaData.getDatabaseProductVersion, False)
1239 End If
1240 Set .Document = oComponent
1241 .Title = oComponent.Title
1242 .URL = .Form.DataSourceName
1243 ._DbConnect = DBCONNECTFORM
1244 Set vDbContainers(i) = vDbContainer
1245 vDbContainers(i).FormName = sFormName
1246 TraceLog(TRACEANY, UCase(cstThisSub) &amp; &quot; &quot; &amp; .URL &amp; &quot; Form=&quot; &amp; vDbContainer.FormName, False)
1247 End With
1248 Next i
1249 vDocContainer.DbConnect = DBCONNECTFORM
1250 End Select
1251
1252 vDocContainer.DbContainers() = vDbContainers()
1253 Set vCurrentDoc(iCurrent) = vDocContainer
1254
1255 _A2B_.CurrentDoc = vCurrentDoc
1256 Set OpenConnection = vDbContainers(0).Database
1257
1258
1259 Exit_Function:
1260 Utils._ResetCalledSub(cstThisSub)
1261 Exit Function
1262 Error_Function:
1263 TraceError(TRACEABORT, Err, cstThisSub, Erl)
1264 Set _A2B_.CurrentDoc = Array()
1265 GoTo Exit_Function
1266 Error_MainForm:
1267 TraceError(TRACEFATAL, ERRMAINFORM, Utils._CalledSub(), False, ,oComponent.Title)
1268 Set _A2B_.CurrentDoc = Array()
1269 GoTo Exit_Function
1270 Trace_Error:
1271 TraceError(TRACEABORT, ERRDBNOTCONNECTED, Utils._CalledSub(), 0,1)
1272 Goto Exit_Function
1273 End Function &apos; OpenConnection V1.1.0
1274
1275 REM -----------------------------------------------------------------------------------------------------------------------
1276 Public Function OpenDatabase ( _
1277 ByVal Optional pvDatabaseURL As Variant _
1278 , ByVal Optional pvUser As Variant _
1279 , ByVal Optional pvPassword As Variant _
1280 , ByVal Optional pvReadOnly As Variant _
1281 ) As Object
1282
1283 &apos; Return a database object based on input arguments:
1284 &apos; Call template:
1285 &apos; Call OpenDatabase(&quot;... databaseURL ...&quot;[, &quot;&quot;, &quot;&quot;, True/False])
1286 &apos; pvDatabaseURL maby be the name of a registered database or the URL of the targeted .odb file
1287 &apos; Might be called from any AOO/LibO application, independently from OpenConnection
1288
1289 Dim odbDatabase As Variant, oBaseContext As Object, sDbNames() As String, oBaseSource As Object
1290 Dim i As Integer, bFound As Boolean
1291 Dim sDatabaseURL As String
1292
1293 If IsEmpty(_A2B_) Then &apos; First use of Access2Base in current AOO/LibO session
1294 Call Application._RootInit()
1295 TraceLog(TRACEANY, Utils._GetProductName() &amp; &quot; - &quot; &amp; Application.ProductCode(), False)
1296 End If
1297 Set OpenDatabase = Nothing
1298
1299 If _ErrorHandler() Then On Local Error Goto Error_Function
1300 Const cstThisSub = &quot;OpenDatabase&quot;
1301 Utils._SetCalledSub(cstThisSub)
1302 If pvDatabaseURL = &quot;&quot; Then Call _TraceArguments()
1303 If Not Utils._CheckArgument(pvDatabaseURL, 1, vbString) Then Goto Exit_Function
1304 If IsMissing(pvUser) Then pvUser = &quot;&quot;
1305 If IsMissing(pvPassword) Then pvPassword = &quot;&quot;
1306 If Not Utils._CheckArgument(pvUser, 2, vbString) Then Goto Exit_Function
1307 If Not Utils._CheckArgument(pvPassword, 3, vbString) Then Goto Exit_Function
1308 If IsMissing(pvReadOnly) Then pvReadOnly = False
1309 If Not Utils._CheckArgument(pvReadOnly, 3, vbBoolean) Then Goto Exit_Function
1310
1311 Set odbDatabase = New Database
1312 Set odbDatabase._This = odbDatabase
1313 odbDatabase._DbConnect = DBCONNECTANY
1314
1315 Set oBaseContext = CreateUnoService(&quot;com.sun.star.sdb.DatabaseContext&quot;)
1316 sDbNames() = oBaseContext.getElementNames()
1317 bFound = False
1318 For i = 0 To UBound(sDbNames()) &apos; Enumerate registered databases and check non case-sensitive equality
1319 If UCase(sDbNames(i)) = UCase(pvDatabaseURL) Then
1320 sDatabaseURL = sDbNames(i)
1321 Set oBaseSource = oBaseContext.getByName(sDatabaseURL)
1322 bFound = True
1323 Exit For
1324 End If
1325 Next i
1326 If Not bFound Then
1327 sDatabaseURL = ConvertToURL(pvDatabaseURL)
1328 If UCase(Right(sDatabaseURL, 4)) &lt;&gt; &quot;.ODB&quot; Then Goto Trace_Error
1329 If Not FileExists(sDatabaseURL) Then Goto Trace_Error
1330 Set oBaseSource = oBaseContext.getByName(sDatabaseURL)
1331 End If
1332
1333 Set odbDatabase.Connection = oBaseSource.getConnection(pvUser, pvPassword)
1334 If Not IsNull(odbDatabase.Connection) Then &apos; Null when standalone and target db does not exist
1335 Set odbDatabase.MetaData = odbDatabase.Connection.MetaData
1336 odbDatabase._LoadMetadata()
1337 Else
1338 Goto Trace_Error
1339 End If
1340
1341 odbDatabase.URL = sDatabaseURL
1342
1343 If pvReadOnly Then
1344 odbDatabase.Connection.isReadOnly = True
1345 odbDatabase._ReadOnly = True
1346 End If
1347
1348 Set OpenDatabase = odbDatabase
1349
1350 TraceLog(TRACEANY, odbDatabase.MetaData.getDatabaseProductName() &amp; &quot; &quot; &amp; odbDatabase.MetaData.getDatabaseProductVersion, False)
1351 TraceLog(TRACEANY, UCase(cstThisSub) &amp; &quot; &quot; &amp; odbDatabase.URL, False)
1352
1353
1354 Exit_Function:
1355 Utils._ResetCalledSub(cstThisSub)
1356 Exit Function
1357 Error_Function:
1358 TraceError(TRACEABORT, Err, cstThisSub, Erl)
1359 GoTo Exit_Function
1360 Trace_Error:
1361 TraceError(TRACEABORT, ERRDBNOTCONNECTED, Utils._CalledSub(), 0,1)
1362 Goto Exit_Function
1363 End Function &apos; OpenDatabase V1.1.0
1364
1365 REM -----------------------------------------------------------------------------------------------------------------------
1366 Public Function ProductCode()
1367 If IsEmpty(_A2B_) Then Call Application._RootInit() &apos; First use of Access2Base in current AOO/LibO session
1368 ProductCode = &quot;Access2Base &quot; &amp; _A2B_.VersionNumber
1369 End Function &apos; ProductCode V0.9.1
1370
1371 REM -----------------------------------------------------------------------------------------------------------------------
1372 Public Function SysCmd(Optional pvAction As Variant _
1373 , Optional pvText As Variant _
1374 , Optional pvValue As Variant _
1375 ) As Variant
1376 &apos; Manage progress meter in the status bar
1377 &apos; Other values supported by MSAccess are ignored
1378
1379 If _ErrorHandler() Then On Local Error Goto Error_Function
1380 Const cstThisSub = &quot;SysCmd&quot;
1381 Utils._SetCalledSub(cstThisSub)
1382 SysCmd = False
1383
1384 Const cstMissing = -1
1385 Const cstBarLength = 350
1386 If IsMissing(pvAction) Then Call _TraceArguments()
1387 If Not Utils._CheckArgument(pvAction, 1, Utils._AddNumeric(), Array( _
1388 acSysCmdAccessDir _
1389 , acSysCmdAccessVer _
1390 , acSysCmdClearHelpTopic _
1391 , acSysCmdClearStatus _
1392 , acSysCmdGetObjectState _
1393 , acSysCmdGetWorkgroupFile _
1394 , acSysCmdIniFile _
1395 , acSysCmdInitMeter _
1396 , acSysCmdProfile _
1397 , acSysCmdRemoveMeter _
1398 , acSysCmdRuntime _
1399 , acSysCmdSetStatus _
1400 , acSysCmdUpdateMeter _
1401 )) Then Goto Exit_Function
1402 If IsMissing(pvValue) Then pvValue = cstMissing
1403 If Not Utils._CheckArgument(pvAction, 1, Utils._AddNumeric()) Then Goto Exit_Function
1404 Select Case pvAction
1405 Case acSysCmdInitMeter, acSysCmdUpdateMeter, acSysCmdSetStatus
1406 If IsMissing(pvText) Then Call _TraceArguments()
1407 If Not Utils._CheckArgument(pvText, 2, vbString) Then Goto Exit_Function
1408 Case Else
1409 End Select
1410 If Not Utils._CheckArgument(pvValue, 3, Utils._AddNumeric()) Then Goto Exit_Function
1411
1412 Dim vBar As Variant, iLen As Integer
1413 Set vBar = _A2B_.StatusBar
1414 Select Case pvAction
1415 Case acSysCmdAccessVer
1416 SysCmd = Application.Version()
1417 Goto Exit_Function
1418 Case acSysCmdSetStatus
1419 If pvValue &lt;&gt; cstMissing Then Goto Error_Arg
1420 iLen = Len(pvText)
1421 vBar = _NewBar()
1422 If Not IsNull(vBar) Then vBar.start(Iif(iLen &gt;= cstBarLength, pvText, pvText &amp; Space(cstBarLength - iLen)), 0)
1423 Case acSysCmdClearStatus
1424 If pvValue &lt;&gt; cstMissing Then Goto Error_Arg
1425 If Not IsNull(vBar) Then
1426 vBar.end()
1427 Set _A2B_.StatusBar = Nothing
1428 End If
1429 Case acSysCmdInitMeter
1430 If pvValue = cstMissing Then Call _TraceArguments()
1431 vBar = _NewBar()
1432 If Not IsNull(vBar) Then vBar.start(pvText, pvValue)
1433 Case acSysCmdUpdateMeter
1434 If pvValue = cstMissing Then Call _TraceArguments()
1435 If Not IsNull(vBar) Then &apos; Otherwise ignore !
1436 vBar.setValue(pvValue)
1437 If Len(pvText) &gt; 0 Then vBar.setText(pvText)
1438 End If
1439 Case acSysCmdRemoveMeter
1440 If Not IsNull(vBar) Then
1441 vBar.end()
1442 Set _A2B_.StatusBar = Nothing
1443 End If
1444 Case acSysCmdRuntime
1445 SysCmd = False
1446 Goto Exit_Function
1447 Case Else
1448 End Select
1449
1450 SysCmd = True
1451
1452 Exit_Function:
1453 Utils._ResetCalledSub(cstThisSub)
1454 Exit Function
1455 Error_Function:
1456 TraceError(TRACEABORT, Err, cstThisSub, Erl)
1457 GoTo Exit_Function
1458 Error_Arg:
1459 TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, 1, Array(3, pvValue))
1460 Goto Exit_Function
1461 End Function &apos; SysCmd V0.9.1
1462
1463 REM -----------------------------------------------------------------------------------------------------------------------
1464 Public Function TempVars(ByVal Optional pvIndex As Variant) As Variant
1465 &apos; Return either a Collection or a TempVar object
1466
1467 If _ErrorHandler() Then On Local Error Goto Error_Function
1468 Const cstThisSub = &quot;TempVars&quot;
1469 Utils._SetCalledSub(cstThisSub)
1470
1471 Dim iMode As Integer, vTempVars As Variant, bFound As Boolean
1472 Const cstCount = 0
1473 Const cstByIndex = 1
1474 Const cstByName = 2
1475
1476 If IsMissing(pvIndex) Then
1477 iMode = cstCount
1478 Else
1479 If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function
1480 If VarType(pvIndex) = vbString Then iMode = cstByName Else iMode = cstByIndex
1481 End If
1482
1483 Set vTempVars = Nothing
1484 Select Case iMode
1485 Case cstCount &apos; Build Collection object
1486 Set vTempVars = New Collect
1487 With vTempVars
1488 ._CollType = COLLTEMPVARS
1489 ._Count = _A2B_.TempVars.Count
1490 End With
1491 Case cstByIndex &apos; Build TempVar object
1492 If pvIndex &lt; 0 Or pvIndex &gt;= _A2B_.TempVars.Count Then Goto Trace_Error_Index
1493 Set vTempVars = _A2B_.TempVars.Item(pvIndex + 1) &apos; Builtin collections start at 1
1494 Case cstByName
1495 bFound = _A2B_.hasItem(COLLTEMPVARS, pvIndex)
1496 If Not bFound Then Goto Trace_NotFound
1497 vTempVars = _A2B_.TempVars.Item(UCase(pvIndex))
1498 End Select
1499
1500 Set TempVars = vTempVars
1501
1502 Exit_Function:
1503 Utils._ResetCalledSub(cstThisSub)
1504 Exit Function
1505 Error_Function:
1506 TraceError(TRACEABORT, Err, cstThisSub, Erl)
1507 GoTo Exit_Function
1508 Trace_Error_Index:
1509 TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0, 1)
1510 Set vTempVars = Nothing
1511 Goto Exit_Function
1512 Trace_NotFound:
1513 TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel(&quot;TEMPVAR&quot;), pvIndex))
1514 Goto Exit_Function
1515 End Function &apos; TempVars V1.2.0
1516
1517 REM -----------------------------------------------------------------------------------------------------------------------
1518 Public Function Version() As String
1519 Version = Utils._GetProductName()
1520 End Function &apos; Version V0.9.1
1521
1522 REM -----------------------------------------------------------------------------------------------------------------------
1523 REM --- PRIVATE FUNCTIONS ---
1524 REM -----------------------------------------------------------------------------------------------------------------------
1525
1526 REM -----------------------------------------------------------------------------------------------------------------------
1527 Public Function _CountOpenForms(ByVal Optional piCountMax As Integer) As Variant
1528 &apos; Return # of active forms if no argument
1529 &apos; Return name of piCountMax-th open form if argument present
1530
1531 Dim i As Integer, iCount As Integer, iAllCount As Integer, ofForm As Variant
1532 iAllCount = AllForms._Count
1533 iCount = 0
1534 If iAllCount &gt; 0 Then
1535 For i = 0 To iAllCount - 1
1536 Set ofForm = Application.AllForms(i)
1537 If ofForm.IsLoaded Then iCount = iCount + 1
1538 If Not IsMissing(piCountMax) Then
1539 If iCount = piCountMax + 1 Then
1540 _CountOpenForms = ofForm &apos; OO3.2 aborts when Set verb present ?!?
1541 Exit For
1542 End If
1543 End If
1544 Next i
1545 End If
1546
1547 If IsMissing(piCountMax) Then _CountOpenForms = iCount
1548
1549 End Function &apos; CountOpenForms V1.1.0
1550
1551 REM -----------------------------------------------------------------------------------------------------------------------
1552 Public Function _CurrentDb(ByVal Optional piDocEntry As Integer, ByVal Optional piDbEntry As Integer) As Variant
1553 REM Without arguments same as CurrentDb() except that it generates an error if database not connected (internal use)
1554 REM With 2 arguments return the corresponding entry in Root
1555
1556 Dim oCurrentDb As Object
1557 If IsEmpty(_A2B_) Then GoTo Trace_Error
1558 If IsMissing(piDocEntry) Then Set oCurrentDb = Application.CurrentDb() _
1559 Else Set oCurrentDb = _A2B_._CurrentDb(piDocEntry, piDbEntry)
1560 If IsNull(oCurrentDb) Then Goto Trace_Error Else Set _CurrentDb = oCurrentDb
1561
1562 Exit_Function:
1563 Exit Function
1564 Trace_Error:
1565 TraceError(TRACEABORT, ERRDBNOTCONNECTED, Utils._CalledSub(), 0, 1)
1566 Goto Exit_Function
1567 End Function &apos; _CurrentDb V1.1.0
1568
1569 REM -----------------------------------------------------------------------------------------------------------------------
1570 Private Function _NewBar() As Object
1571 &apos; Close current status bar, if any, and initialize new one
1572
1573 Dim vBar As Variant, vWindow As Variant, vController As Object
1574 On Local Error Resume Next
1575 Set _NewBar = Nothing
1576
1577 Set vBar = _A2B_.StatusBar
1578 If Not IsNull(vBar) Then
1579 If Utils._hasUNOMethod(vBar, &quot;end&quot;) Then vBar.end()
1580 Set _A2B_.StatusBar = Nothing
1581 End If
1582
1583 Set vBar = Nothing
1584 Set vWindow = _SelectWindow()
1585 If IsNull(vWindow.Frame) Then Exit Function
1586 Select Case vWindow.WindowType
1587 Case acForm, acReport, acBasicIDE, acDocument &apos; Not found how to make it work for acDatabaseWindow
1588 Case Else
1589 Exit Function
1590 End Select
1591 If Utils._hasUNOMethod(vWindow.Frame, &quot;getCurrentController&quot;) Then
1592 Set vController = vWindow.Frame.getCurrentController()
1593 ElseIf Utils._hasUNOMethod(vWindow.Frame, &quot;getController&quot;) Then
1594 Set vController = vWindow.Frame.getController()
1595 End If
1596
1597 If Utils._hasUNOMethod(vController, &quot;getStatusIndicator&quot;) Then vBar = vController.getStatusIndicator()
1598 Set _A2B_.StatusBar = vBar
1599 Set _NewBar = vBar
1600 Exit Function
1601
1602 End Function &apos; _NewBar V1.1.0
1603
1604 REM -----------------------------------------------------------------------------------------------------------------------
1605 Private Function _NewCommandBar(psModule As String _
1606 , psToolbarName As String _
1607 , psToolbarFullName As String _
1608 , piBuiltin As Integer _
1609 ) As Object
1610
1611 Dim oObject As Object
1612 Set oObject = New CommandBar
1613 With oObject
1614 ._Type = OBJCOMMANDBAR
1615 ._Name = psToolbarName
1616 ._ResourceURL = psToolbarFullName
1617 ._Module = psModule
1618 ._BarBuiltin = piBuiltin
1619 Select Case UCase(Split(psToolbarFullName, &quot;/&quot;)(1))
1620 Case &quot;MENUBAR&quot; : ._BarType = msoBarTypeMenuBar
1621 Case &quot;STATUSBAR&quot; : ._BarType = msoBarTypeStatusBar
1622 Case &quot;TOOLBAR&quot; : ._BarType = msoBarTypeNormal
1623 Case &quot;POPUP&quot; : ._BarType = msoBarTypePopup
1624 Case &quot;FLOATER&quot; : ._BarType = msoBarTypeFloater
1625 Case Else : ._BarType = -1
1626 End Select
1627 End With
1628 Set _NewCommandBar = oObject
1629 Exit Function
1630
1631 End Function &apos; NewCommandBar V1.3.0
1632
1633 REM -----------------------------------------------------------------------------------------------------------------------
1634 Public Sub _RootInit(Optional ByVal pbForce As Boolean)
1635 &apos; Initialize _A2B_ global variable. Reinit forced if pbForce = True
1636
1637 If IsMissing(pbForce) Then pbForce = False
1638 If IsEmpty(_A2B_) Or pbForce Then _A2B_ = New Root_
1639
1640 End Sub &apos; _RootInit V1.1.0
1641
1642 </script:module>
FREE OFFICE SUITE