Application.xba 74 KB

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