Useful Macro Information

For OpenOffice

By

Andrew Pitonyak

This is not the same as my book

OpenOffice.org Macros Explained.

My book is a more complete and organized presentation. This document, is primarily a random collection of thoughts and examples (brain dump).

Last Modified

Monday, October 10, 2005 at 10:09:24 am

Thank You

Thanks to my wife Michelle Pitonyak for supporting and encouraging me to write this document. Thank you Laurent Godard (and the French translation team) for your good ideas and hard work. Thanks to Hermann-Josef Beckers for his German translation. Robert Black Eagle you were tireless and offered excellent insight, not to mention your wonderful Master Document “Howto”. Kelvin Eldridge, you have great understanding and have helped me understand numerous bugs. Jean Hollis Weber and Solveig Haugland, thank you for the personal replies when I had specific document usage problems. Sasa Kelecevic, and Hermann Kienlein, you have provided many working examples to help me. Andreas Bregas, thank you for the quick replies, descriptions, and fixes. Mathias Bauer, thank you for the explanations and examples revealing the deep mysteries of the internals. I owe a large thank you to the entire open-source community and the mailing lists for providing helpful information and support. Finally, I should thank Jean Hollis Weber and C Robert Pearsall for agreeing to be technical editors for my book due for publication in August of 2004. Thanks to Christian Junker, for reviewing and making extensive changes and additions to the document – Christian spent numerous hours proofreading and providing updates.

Disclaimer

The material in this document carries no guarantee of applicability, accuracy, or safety. Use the information and macros in this document at your own risk. In the unlikely event that they cause the loss of some or all of your data and/or computer hardware, that neither I, nor any of the contributors, will be held responsible.

Contact Information

Andrew Pitonyak • 6888 Bowerman Street West • Worthington, OH 43085 • USA
home: andrew@pitonyak.org • work:

home telephone: 614-438-0190 • cell telephone: 614-937-4641

Credentials

I have two Bachelors of Science degrees, one in Computer Science and one in Mathematics. I also have two Masters of Science degrees, one in Applied Industrial Mathematics and one in Computer Science. I have spent time at Oakland University in Rochester Michigan, The Ohio State University in Columbus Ohio, and at The Technical University Of Dresden in Dresden Germany.

Public Documentation License Notice

The contents of this Documentation are subject to the Public Documentation License Version 1.0 (the "License"); you may only use this Documentation if you comply with the terms of this License.

A copy of the License is available at http://www.openoffice.org/licenses/pdl.pdf

The Original Documentation is http://www.pitonyak.org/AndrewMacro.sxw

Contribution	Contributor	Contact	Copyright
Original author	Andrew Pitonyak	andrew@pitonyak.org	2002-2005
French translation	The French Native-lang documentation project	doc@fr.openoffice.org	2003
German Translation	Hermann-Josef Beckers	hjb-rheine@t-online.de	2003
Macros	Hermann Kienlein	info@kienlein.com	2002-2003
Macros	Sasa Kelecevic	scat@teol.net	2002-2003
Editing and additions	Christian Junker	usboy2004@web.de	2004

Table of Contents

1. Introduction	1

1.1. Abbreviations and definitions	1

2. Available Resources	3

2.1. Included Material	3

2.2. On line Resources	3

2.3. Translations of this document	4

3. Getting started: concepts	5

3.1. My first macro: “Hello World”	5

3.2. Grouping Code	5

3.3. Debugging	6

3.4. Variables, Constants, Strings and numerical Types	6

3.5. Accessing And Creating Objects In OpenOffice	6

3.6. Services	7

3.7. Inspecting The Object	8

3.7.1. What Type Is It?	8

3.7.2. What Can This Object Do?	10

3.8. Languages other than Basic	11

3.8.1. CreateUnoService	11

3.8.2. ThisComponent	11

3.8.3. StarDesktop	12

3.8.4. Accessing methods and properties	12

4. Examples	15

4.1. Debugging And Inspecting Macros	15

4.1.1. Determine Document Type	15

4.1.2. Display Object Methods And Properties	16

4.1.3. Display Object Properties In Spreadsheet	17

4.1.4. A Better Way To Do It	24

4.2. Dispatch: Using Universal Network Objects (UNO)	24

4.2.1. The Dispatcher Changed In Version 1.1	26

4.2.2. Using the dispatcher requires a user interface.	26

4.2.2.1. Modifying the menu – a dispatcher example	26

4.3. Intercept menu commands using Basic	27

5. Miscellaneous Examples	29

5.1. Display Text In Status Bar	29

5.2. Display All Styles In The Current Document	29

5.3. Iterate Through All Open Documents	30

5.4. List Fonts And Other Screen Information	30

5.4.1. Display supported fonts	31

5.5. Set the default font using the ConfigurationProvider	31

5.6. Print Current Document	32

5.6.1. Print Current Page	33

5.6.2. Other Printing Arguments	33

5.6.3. Landscape	33

5.7. Configuration information	33

5.7.1. OOo version	33

5.7.2. OOo Locale	34

5.8. Open And Close Documents (And The Desktop)	34

5.8.1. Close OpenOffice And/Or Documents	34

5.8.1.1. What if the file is modified?	35

5.8.2. Load A Document From A URL	35

5.8.2.1. A complete example	37

5.8.3. Create a new document from a template	38

5.8.4. How do I Enable Macros With LoadComponentFromURL	38

5.8.5. Error handling on load	39

5.8.6. Mail Merge example, merge all documents in a directory	40

5.9. Creating A Table	41

5.9.1. A table with no borders	42

5.10. Loading/Inserting a graphic into your document	43

5.10.1. Convert a linked graphic to an embedded graphic.	44

5.10.2. Danny Brewer embeds a graphic	45

5.10.3. Embed a graphics using a dispatch	45

5.10.4. Embed a graphics directly	46

5.11. Setting Margins	46

5.11.1. Setting the paper size	47

5.12. Calling an external program (Internet Explorer) using OLE	48

5.13. Use the Shell command for files containing spaces	48

5.14. Read And Write Number In File	48

5.15. Create Number Format Style	50

5.15.1. View Supported Number Format Styles	50

5.16. Return the Fibonacci array	51

5.17. Insert Text At Bookmark	52

5.18. Saving And Exporting A Document	52

5.19. User Fields	53

5.19.1. Document Information	53

5.19.2. Text Fields	54

5.19.3. Master Fields	55

5.19.4. Removing Text Fields	59

5.19.5. Insert a URL into a Calc cell	59

5.19.6. Adding a SetExpression TextField	60

5.20. User Defined Data Types	60

5.21. Spell Check, Hyphenation, and Thesaurus	61

5.22. Changing The Mouse Cursor	62

5.23. Setting The Page Background	63

5.24. Manipulating The Clipboard	63

5.24.1. Copy Spreadsheet Cells With The Clipboard	63

5.24.2. Copy Spreadsheet Cells Without The Clipboard	64

5.24.3. Getting the content-type of the Clipboard	65

5.25. Setting The Locale (Language)	65

5.26. Setting the locale for selected text	66

5.27. Auto Text	68

5.28. Decimal Feet To Fraction	70

5.28.1. Convert number to words	73

5.29. Sending Email	76

5.30. Libraries	78

5.30.1. The library container	79

5.30.2. Warning about unpublished services	80

5.30.3. What does it means to load a Library?	80

5.30.4. Distribute/deploy a library	80

5.31. Setting Bitmap Size	81

5.31.1. Insert, size, and position a graphic in a Calc document.	82

5.31.2. Export an image at a specified size	83

5.31.3. Draw a Line in a Calc Document	84

5.32. Extracting a Zip File	85

5.32.1. Another Zip File Example	86

5.32.2. Zip Entire Directories	87

5.33. Run a macro by string name	89

5.34. Using a “default application” to open a file	89

5.35. Listing Fonts	90

5.36. Get the document URL, filename, and directory	90

5.37. Get and set the current directory	91

5.38. Writing to a file	93

5.39. Parsing XML	93

5.40. Manipulating Dates	96

5.41. Is OpenOffice embedded into a web browser?	97

5.42. Focus (bring to the front) a new document	97

5.43. Accessing the clipboard	98

5.44. What is the document type (based on URL)	98

5.45. Connect to a remote OOo server using Basic	99

6. Calc macros	101

6.1. Is this a spreadsheet document?	101

6.2. Display cell value, string, or formula	101

6.3. Set cell value, format, string, or formula	101

6.3.1. Reference a cell in another document	102

6.4. Clear a cell	102

6.5. Selected text, what is it?	102

6.5.1. Get the active cell and ignore the rest	103

6.6. Human readable address of cell	104

6.7. Insert formatted date into cell	105

6.7.1. A shorter way to do it	106

6.8. Display selected range in message box	106

6.9. Fill selected range with text	107

6.10. Some stats on a selected range	107

6.11. Database range	108

6.11.1. Set selected cells to a database range	108

6.11.2. Delete database range	109

6.12. Table borders	109

6.13. Sort range	110

6.14. Display all data in a column	111

6.15. Using Outline (Grouping) Methods	111

6.16. Protecting your data	112

6.17. Setting header and footer text	112

6.18. Access a form control in Calc via OOo Basic	113

6.19. Copying spreadsheet cells	113

6.19.1. Copy entire sheet to a new document	113

6.20. Select a named range	114

6.21. Convert data in column format into rows	115

6.22. Toggle Automatic Calculation	116

6.23. Which cells are used in a sheet?	117

6.24. Searching a Calc document	118

6.25. Print a Calc range	120

6.26. Is a cell merged?	121

7. Writer Macros	123

7.1. Selected Text, What Is It?	123

7.1.1. Is the cursor in a text table?	123

7.1.2. Can I check the current selection for a TextTable or Cell?	124

7.2. Text Cursors, What Are They?	124

7.2.1. You can not move a cursor to a TextTable anchor.	125

7.2.2. You can move a cursor to a Bookmark anchor.	126

7.3. Andrew's Selected Text Framework	127

7.3.1. Is Text Selected?	127

7.3.2. How To Get A Selection	128

7.3.3. Selected Text, Which End Is Which	129

7.3.4. The Selected Text Framework Macro	130

7.3.4.1. The Rejected Framework	130

7.3.4.2. The Accepted Framework	131

7.3.4.3. The Main Worker	132

7.3.5. Counting Sentences	132

7.3.6. Remove Empty Spaces And Lines, A Larger Example	133

7.3.6.1. Define “White Space”	133

7.3.6.2. Rank Characters For Deletion	133

7.3.6.3. The Standard Selected Text Iterator	134

7.3.6.4. The Worker Macro	134

7.3.7. Removing Empty Paragraphs, Yet Another Example	135

7.3.8. Selected Text, Timing Considerations And Counting Words	136

7.3.8.1. Searching Selected Text To Count Words	136

7.3.8.2. Using Strings To Count Words	136

7.3.8.3. Using A Character Cursor To Count Words	138

7.3.8.4. Using A Word Cursor To Count Words	139

7.3.8.5. Final Thoughts On Counting Words And Timing	140

7.3.9. Counting Words, You Should Use This Macro!	140

7.4. Replacing Selected Space Using Strings	142

7.4.1. Compare Cursors And String Examples	144

7.5. Setting Text Attributes	152

7.6. Insert text	153

7.6.1. Insert new paragraph	153

7.7. Fields	154

7.7.1. Insert a formatted date field into a Write document	154

7.7.2. Inserting a Note (Annotation)	154

7.8. Inserting A New Page	155

7.8.1. Removing Page Breaks	156

7.9. Set The Document Page Style	156

7.10. Insert An OLE Object	156

7.11. Setting Paragraph Style	157

7.12. Create Your Own Style	157

7.13. Search And Replace	158

7.13.1. Replacing Text	158

7.13.2. Searching Selected Text	159

7.13.3. Complicated Search And Replace	160

7.13.4. Search and Replace with Attributes and Regular Expressions	160

7.14. Changing The Case Of Words	161

7.15. Andrew Learns to Traverse Paragraphs	162

7.15.1. What does it mean to enumerate text content?	165

7.15.2. Enumerating text and finding text content	167

7.15.3. But I only want to find the graphics objects	169

7.15.4. Find a text field contained in the current paragraph?	169

7.16. Where is the Display Cursor?	171

7.16.1. Which cursor should I use to delete a line or a paragraph	173

7.16.2. Delete the current page	173

7.17. Insert an index or table of contents	174

7.18. Inserting a URL into a Write document	175

7.19. Sorting Text	175

7.20. Outline numbering	176

7.21. Insert a table of contents (TOC) or other index.	177

7.22. Text tables	178

7.22.1. Column Widths	178

7.22.2. Setting the optimal column width	179

7.22.3. How wide is a TextTable?	179

7.22.4. The cursor in a text table	180

7.23. Text sections	181

8. Forms	183

8.1. Introduction	183

8.2. Dialogs	183

8.2.1. Controls	184

8.2.2. Control Label	185

8.2.3. Control Button	185

8.2.4. Text Box	185

8.2.5. List Box	185

8.2.6. Combo Box	186

8.2.7. Check Box	186

8.2.8. Option/Radio Button	186

8.2.9. Progress Bar	186

8.3. Obtaining Controls	187

8.3.1. Size and location of a Control by name.	187

8.3.2. Which control called a handler and where is it located?	188

8.4. Choosing a File Using the File Dialog	189

8.5. Center a dialog on the screen	189

8.6. Set the event listener for a control	190

8.7. Controlling a dialog I did not create.	191

8.7.1. Inserting a formula	191

8.7.2. Discovering the accessible content (by Andrew)	193

8.7.3. Manipulating the Options dialog	195

8.7.4. Listing the supported printers	197

8.7.5. Finding an open window	198

8.7.6. Inspecting accessible content (by ms777)	199

9. Database	203

9.1. Available Resources	203

9.2. Database server	203

9.3. Database client	204

9.4. Database connection	204

9.5. Data Source	204

9.6. SQL	204

9.7. Connect to a data source and get a value from a table	205

10. Investment Example	207

10.1. Summary Page	207

10.2. Detail Sheet	207

10.3. Check A Column For Duplicates	208

10.3.1. Printable Cell Address From Cell	208

10.3.2. Count Non-Empty Entries In Column	209

10.3.3. Sorted Array	210

10.3.4. Find The Duplicate	210

11. Handlers and Listeners	213

11.1. XKeyHandler	213

11.1.1. Reduced Compose Macro Description	213

11.1.2. Leston's Comments	213

11.1.3. Implementation	214

11.2. Listener Write-Up by Paolo Mantovani	215

11.2.1. The CreateUnoListener function	215

11.2.2. Nice, but what does it do?	216

11.2.3. Quite useless, but tell me more...	216

11.2.4. Example 1: com.sun.star.view.XSelectionChangeListener	217

11.2.5. Example 2: com.sun.star.view.XPrintJobListener	218

11.2.6. Example 3: com.sun.star.awt.XKeyHandler	219

11.2.6.1. Andrew has a little something to add	220

11.2.7. Example 4: com.sun.star.awt.XMouseClickHandler	221

11.2.8. Example 5: Manual binding of events	222

11.3. What happened to my ActiveSheet listener?	222

12. Language	225

12.1. Comments	225

12.2. Variables	225

12.2.1. Names	225

12.2.2. Declaration	225

12.2.3. Evil Global Variables And Statics	226

12.2.4. Types	227

12.2.4.1. Boolean Variables	228

12.2.4.2. Integer Variables	228

12.2.4.3. Currency Variables	229

12.2.4.4. Single Variables	229

12.2.4.5. Double Variables	229

12.2.4.6. String Variables	229

12.2.5. Object, Variant, Empty, and Null	229

12.2.6. Should I Use Object Or Variant	230

12.2.7. Constants	230

12.2.8. Arrays	231

12.2.8.1. Option Base	231

12.2.8.2. LBound(arrayname[,Dimension])	231

12.2.8.3. UBound(arrayname[,Dimension])	231

12.2.8.4. Is This Array Defined	232

12.2.9. DimArray, Changing The Dimension	232

12.2.10. ReDim, Changing The Number Of Elements	232

12.2.11. Testing Objects	233

12.2.12. Comparison Operators	233

12.3. Functions and SubProcedures	234

12.3.1. Optional Parameters	235

12.3.2. Parameters By Reference Or Value	235

12.3.3. Recursion	236

12.4. Flow Control	237

12.4.1. If Then Else	237

12.4.2. IIF	237

12.4.3. Choose	237

12.4.4. For....Next	238

12.4.5. Do Loop	239

12.4.6. Select Case	239

12.4.6.1. Case Expressions	240

12.4.6.2. Incorrect Simple Example	240

12.4.6.3. Incorrect Range Example	240

12.4.6.4. Incorrect Range Example	241

12.4.6.5. Ranges, The Correct Way	241

12.4.7. While...Wend	241

12.4.8. GoSub	242

12.4.9. GoTo	242

12.4.10. On GoTo	243

12.4.11. Exit	243

12.4.12. Error Handling	244

12.4.12.1. Specify How To Handle The Error	244

12.4.12.2. Write The Error Handler	244

12.4.12.3. An Example	245

12.5. Miscellaneous	246

13. Operators and Precedence	249

14. String Manipulations	251

14.1. Remove Characters From String	251

14.2. Replace Text In String	252

14.3. Printing The ASCII Values Of A String	252

14.4. Remove All Occurrences Of A String	253

15. Numeric Manipulations	255

16. Date Manipulations	257

17. File Manipulations	259

18. Operators, Statements, and Functions	261

18.1. Subtraction operator (-)	261

18.2. Multiplication operator (*)	261

18.3. Addition operator (+)	261

18.4. Power operator (^)	262

18.5. Division operator (/)	262

18.6. AND Operator	263

18.7. Abs Function	264

18.8. Array Function	264

18.9. Asc Function	265

18.10. ATN Function	266

18.11. Beep Statement	266

18.12. Blue Function	266

18.13. ByVal Keyword	267

18.14. Call Keyword	268

18.15. CBool Function	268

18.16. CByte Function	269

18.17. CDate Function	269

18.18. CDateFromIso Function	270

18.19. CDateToIso Function	270

18.20. CDbl Function	271

18.21. ChDir statement is deprecated	271

18.22. ChDrive statement is deprecated	272

18.23. Choose Function	272

18.24. Chr Function	273

18.25. CInt Function	273

18.26. CLng Function	274

18.27. Close Statement	274

18.28. Const Statement	275

18.29. ConvertFromURL Function	275

18.30. ConvertToURL Function	276

18.31. Cos Function	276

18.32. CreateUnoDialog Function	277

18.33. CreateUnoService Function	278

18.34. CreateUnoStruct Function	279

18.35. CSng Function	279

18.36. CStr Function	280

18.37. CurDir Function	280

18.38. Date Function	281

18.39. DateSerial Function	281

18.40. DateValue Function	282

18.41. Day Function	283

18.42. Declare Statement	283

18.43. DefBool Statement	284

18.44. DefDate Statement	285

18.45. DefDbl Statement	285

18.46. DefInt Statement	285

18.47. DefLng Statement	286

18.48. DefObj Statement	286

18.49. DefVar Statement	287

18.50. Dim Statement	287

18.51. DimArray Function	288

18.52. Dir Function	288

18.53. Do...Loop Statement	290

18.54. End Statement	291

18.55. Environ Function	291

18.56. EOF Function	292

18.57. EqualUnoObjects Function	293

18.58. EQV Operator	293

18.59. Erl Function	294

18.60. Err Function	295

18.61. Error statement does not work as indicated.	295

18.62. Error Function	296

18.63. Exit Statement	296

18.64. Exp Function	297

18.65. FileAttr Function	298

18.66. FileCopy Statement	299

18.67. FileDateTime Function	299

18.68. FileExists Function	300

18.69. FileLen Function	300

18.70. FindObject Function	301

18.71. FindPropertyObject Function	301

18.72. Fix Function	302

18.73. For...Next Statement	303

18.74. Format Function	303

18.75. FreeFile Function	305

18.76. FreeLibrary Function	306

18.77. Function Statement	306

18.78. Get Statement	307

18.79. GetAttr Function	308

18.80. GetProcessServiceManager Function	309

18.81. GetSolarVersion Function	309

18.82. GetSystemTicks Function	310

18.83. GlobalScope Statement	311

18.84. GoSub Statement	311

18.85. GoTo Statement	312

18.86. Green Function	312

18.87. HasUnoInterfaces Function	313

18.88. Hex Function	313

18.89. Hour Function	314

18.90. If Statement	315

18.91. IIF Statement	315

18.92. Imp Operator	316

18.93. Input Statement	317

18.94. InputBox Function	318

18.95. InStr Function	318

18.96. Int Function	319

18.97. IsArray Function	320

18.98. IsDate Function	320

18.99. IsEmpty Function	321

18.100. IsMissing Function	321

18.101. IsNull Function	322

18.102. IsNumeric Function	322

18.103. IsObject Function	323

18.104. IsUnoStruct Function	323

18.105. Kill Function	324

18.106. LBound Function	324

18.107. LCase Function	325

18.108. Left Function	325

18.109. Len Function	326

18.110. Let Function	326

18.111. Line Input Statement	327

18.112. Loc Function	327

18.113. Lof Function	328

18.114. Log Function	329

18.115. Loop Statement	329

18.116. LSet Statement	330

18.117. LTrim Function	331

18.118. Private Keyword	331

18.119. Public Keyword	332

18.120. Red Function	332

18.121. RSet Statement	333

18.122. Shell Function	333

18.123. UBound Function	335

18.124. UCase Function	336

18.125. URL Notation And Filenames	336

18.125.1. URL Notation	336

18.125.2. Paths With Spaces And Other Special Characters	337

18.125.3. Anchoring To The Home Directory On Unix	337

19. Other languages	339

19.1. C#	339

19.2. Visual Basic Programmers	340

19.2.1. ActiveWorkbook	340

19.2.2. ActiveSheet and ActiveCell	341

20. Index	343

Introduction

This is “Andrew's Macro Document”, the free document that started before I wrote my published book. The book contains excellent material for beginners, with complete tested examples, reference material, and figures. The book is a reference for the supported Basic commands. This document covers significantly fewer commands, is not as accurate, or indept. In other words, consider obtaining a copy of my published book “OpenOffice.org Macros Explained” (see http://www.pitonyak.org/book/”).

When I wrote my first macro for OpenOffice, I was overwhelmed by the complexity. I started a list of macros that accomplished simple tasks. I started creating a documenting macros requested by the user community. My quest to understand OOo macros became this document.

This document is frequently updated and available from my web site:
http://www.pitonyak.org/AndrewMacro.sxw

The Last Modified time is found on the title page. My web page also indicates the last uploaded date and time. Although the template used to create this document is not required, it is available on my web site.

Abbreviations and definitions

OpenOffice.org is frequently abbreviated as OOo. OOo Basic is the name of the macro language included with OpenOffice. OOo Basic is similar to Visual Basic so knowledge of Visual Basic is a great advantage.

Table 1.1. Common abbreviations and definitions.

Abbreviation	Definition
GUI	Graphical User Interface
IDE	Integrated Development Environment
UNO	Universal Network Objects
IDL	Interface Definition Language
SDK	Software Development Kit
OLE	Object Linking and Embedding
COM	Component Object Model
OOo	OpenOffice.org

Available Resources

Included Material

Use Help | OpenOffice.org Help to open the OOo help pages. OOo contains help for Writer, Calc, Base, Basic, Draw, Math, and Impress. The upper left corner of the OOo help system contains a drop down list that determines which help set is displayed (see Figure 2.1). To view the help for Basic, the drop down must display “Help about OpenOffice.org Basic”.

Figure 2.1: OOo help pages for Basic.

Many excellent macros are included with OOo. For example, I found a macro that prints the property and method names for an object. I used these methods before I wrote my own object inspector. Use Tools | Macros | Organize Macros | OpenOffice.org Basic (Prior to verion 2.0, use Tools | Macros | Macro) to open the Macro dialog. Expand the Tools library in the OpenOffice.org library container. Inspect the Debug module – some good examples include WritedbgInfo(document) and printdbgInfo(sheet).

Tip	Before running a macro, the library that contains the macro must be loaded. The first chapter of my book, which discusses libraries in depth, is available as a free download (see http://www.pitonyak.org/book/”). This is a great introduction for a beginner and it is free.

On line Resources

The following links and references help decrypt the initially difficult paradigm:

http://www.openoffice.org (the main link)

http://www.oooforum.org (if you need help with your macros this is the perfect place to ask, probably one of the best supported forums on the web)

http://api.openoffice.org/docs/common/ref/com/sun/star/module-ix.html (this is the official IDL reference, here you'll find almost every command with a description)

http://api.openoffice.org/DevelopersGuide/DevelopersGuide.html (The second official Documentation, explains everything in detail on almost 1000 pages!)

http://www.pitonyak.org/AndrewMacro.sxw (Latest copy of this document)

http://www.pitonyak.org/book/ (buy a copy of my book)

http://docs.sun.com/db/doc/817-1826-10 (Sun wrote a book on macro programming. This contains the same errors as the included help files, but it is still an excellent place to start. Very well written and laid out)

http://api.openoffice.org/basic/man/tutorial/tutorial.pdf (Excellent)

http://docs.sun.com/db/coll/999.2?q=star+office (original Sun documentation)

http://api.openoffice.org (This site takes some getting used to but it is very complete)

http://documentation.openoffice.org Download the “How To” document referenced below. http://documentation.openoffice.org/HOW_TO/various_topics/How_to_use_basic_macros.sxw

http://udk.openoffice.org (Here you will find advanced information about UNO)

http://udk.openoffice.org/common/man/tutorial/office_automation.html (OLE)

http://ooextras.sourceforge.net/ (Examples)

http://disemia.com/software/openoffice/ (Examples, mainly for the Calculator)

http://kienlein.com/pages/oo.html (Examples)

http://www.darwinwars.com/lunatic/bugs/oo_macros.html (Examples)

http://sourceforge.net/project/showfiles.php?group_id=43716 (Examples)

http://www.kargs.net/openoffice.html (Examples)

http://www.8daysaweek.co.uk/ (Examples and Documentation)

http://ooo.ximian.com/lxr/ (you can dig through the source code online here)

http://homepages.paradise.net.nz/hillview/OOo/ (numerous excellent macros here including reveal codes macros, key macros, and, information on converting from MS Office)

To find detailed specific information, search the Developer's Guide or perform a web search such as “cursor OpenOffice”. To limit the search, use the following search: “site:api.openoffice.org cursor”.

If I know the package name, I can usually guess the web location. I inspect the API web site at least as often as I inspect objects. http://api.openoffice.org/docs/common/ref/com/sun/module-ix.html

Translations of this document

Table 2.1. Translations of this document.

Link	Language
http://www.pitonyak.org/AndrewMacro.sxw	English
http://fr.openoffice.org/Documentation/Guides/Indexguide.html*	French
http://www.pitonyak.org/AndrewMacroGerman.sxw*	German

* The translations are not up to date, especially the German version.

Getting started: concepts

The first chapter of my book, which is available as a free download, is a more complete user friendly getting started. I consider it a much better place to start (see http://www.pitonyak.org/book/).

A Macro is used to automate task in OpenOffice.org. A macro can automate actions that otherwise require exhausting error-prone manual labor. Currently, the automatic actions are most easily created by writing Macros in OOo Basic. The new scripting framework in OOo version 2 should ease the use of other languages, but Basic is still the most easiest to use. Here are some of the advantages of using the OOo Basic language to control OOo:

easy to learn

supports COM (ActiveX) and advanced GUI features in OpenOffice

on line user-community

cross platform solution

Tip	OpenOffice.org Basic is also known as StarBasic.

My first macro: “Hello World”

Open a new OOo document. Use Use Tools | Macros | Organize Macros | OpenOffice.org Basic to open the Macro dialog. On the left hand side of the dialog, find the document that you just opened. It is probably called “untitled1”. Single click underneath “untitled1” where it says “standard”. Click the “new” button on the far right to create a new module. Using the default name “Module1” is probably not the best choice. when you have multiple documents open and they all have a module named “Module1”, it may become difficult to tell them apart. For now, name your first module “MyFirstModule”. The OOo Basic IDE will open. Enter the code shown in Listing 3.1.

Listing 3.1: Your first simple macro, “Hello world”.

Sub Main

Print "Hello World"

End Sub

Click the run button in the tool-bar to run your first OOo Basic macro.

Grouping Code

OOo Basic is based on subroutines and functions, which are defined using the key words Sub and Function – I interchangeably refer to these as procedures, routines, subroutines, or functions. Each routine provides can call other routines. The difference between a Sub and a Function, is that a Function returns a value and a Sub does not. The macro in Listing 3.2 obtains the text string from the function named HellowWorldString.

Listing 3.2: “Hello world” using a subroutine and a function.

Sub HelloWorld

Dim s As String

s = HelloWorldString()

MsgBox s

End Sub

Function HelloWorldString() As String

HelloWorldString = "Hello World"

End Function

A module contains a collection of procedures. A library contains modules. A document may contain a library – or more than one library. A library can also exist at the application level.

Debugging

The IDE contains debugging capabilities, such as setting break points and watch variables. You can also single step through your code. It is useful to set the breakpoint before the suspected error and then single step through the code to see how the error happens.

Variables, Constants, Strings and numerical Types

A variable is similar to a box that contains something. Like a box, some variables are more suited to contain certain type of data. A variables' type determines what it can store. Attempting to store the wrong type of data into a variable, will frequently cause an error. Technically speaking, this error is called an Exception. Before a variable can be used, it must be given a name. A simple variable declaration is as follows:

Listing 3.3: Declare a simple variable.

Dim <variablename> as <Type>

Variables are dynamic – and without them you can not store data! Like a box, a variable's content can change. I have a box in my room and only I can change what the box contains. Well, I am married, so my wife can also change what my box contains. Technically speaking, a variable's scope specifies where the variable is accessible. You can define a variable to be accessible only in one subroutine, for an entire module, and even globally for all libraries. The keywords “Global”, “Public”, and “Private” are used to define a variable's scope. the location in your macro where the variable is declared also affects its scope.

A variable whose content can not be changed is called a Constant. A constant is declared using the Const keyword.

Listing 3.4: Declare a constant.

Const <constantname> = <constantvalue>

OOo Basic supports many different data types. Strings are simple text values delimited by double quotation marks. For numbers, both integer and floating point data types are supported. To learn more about variables, refer to section 12 Language on page 239 and also refer to the OOo Help. You can also refer to my book “OpenOffice.org Macros Explained”.

Accessing And Creating Objects In OpenOffice

OpenOffice.org implements a large number of Services (Objects); usually, services are easily available. Access the current document and the desktop using the global variables ThisComponent and StarDesktop respectively – both of these global variables represent an Object. When you have a document, you can access its interface (see Listing 3.5).

Listing 3.5: Declare and use some variables.

Sub Example

Dim oDoc As Variant ' This will reference the active document.

Dim oText As Variant ' This will reference the document's main Text object.

oDoc = ThisComponent ' Get the active document

oText = oDoc.getText() ' Get the TextDocument service

End Sub

To create an instance of a service, use the global method createUnoService() as shown in Listing 3.6. This also demonstrates how to create a structure.

Listing 3.6: This is the old way of executing a dispatch.

Sub PerformDispatch(vObj, uno$)

Dim vParser ' This will reference a URLTransformer.

Dim vDisp 'Return value from the dispatch.

Dim oUrl As New com.sun.star.util.URL 'Create a Structure (this is not a service).

oUrl.Complete = uno$

vParser = createUnoService("com.sun.star.util.URLTransformer")

vParser.parseStrict(oUrl)

vDisp = vObj.queryDispatch(oUrl,"",0)

If (Not IsNull(vDisp)) Then vDisp.dispatch(oUrl,noargs())

End Sub

Tip	The Developer's Guide says that the Variant type should be used rather than the object type. This is mentioned in more detail on page 230.
Tip	Although you can create a desktop instance as shown below, you should use the global variable StarDesktop instead. You only need to create the desktop in languages other than StarBasic. createUnoService("com.sun.star.frame.Desktop")

Services

In OOo, most of the functionality is defined by interfaces and services. An interface defines methods. If an object implements an interface, then that object implements the methods defined by the interface. A simple example of an interface is the “Searchable” service. see:
http://api.openoffice.org/docs/common/ref/com/sun/star/util/XSearchable.html

Table 3.1: Methods defined by the com.sun.star.util.XSearchable interface.

Method	Description
createSearchDescriptor	Create a descriptor that defines how to search.
findAll	Search the contained texts for all occurrences.
findFirst	Search the contained texts for the first occurrence.
findNext	Search the contained texts for the next occurrence.

The URL shown above, is called the IDL. Although the IDL provides sufficient information to use the interface, no implementation information is provided. The IDL also provides information on the return values. See page 158 for more information on searching.

If an object supports a service, then it implements the interfaces that are exported by that service. The object also exports the properties defined as supported by the service. Use the SupportsService method to determine if an object supports a particular service. Listing 3.7 demonstrates how to check if a variables references a Writer document.

Listing 3.7: Does the variable oDoc refer to a TextDocument?

If oDoc.supportsService("com.sun.star.text.TextDocument") Then

At the risk of mentioning advanced topics early in the game, consider error handling as mentioned later in this document. What if the variable oDoc is null? What if oDoc is a structure or it does not have the supportsService() method? If it really matters, be certain to setup an error handler using the “On Error” syntax.

More information on how to obtain more information about a specific object at:
http://api.openoffice.org/docs/common/ref/com/sun/star/lang/XServiceInfo.html

Tip	Use the global method createUnoService() to create a service. Languages other than OOo Basic frequently require the use of the createInstance method available from a service manager, which I will not describe at this point.

Inspecting The Object

What Type Is It?

It is useful to know the object type so that you know what you can do with it. Here is a brief list of inspection methods:

Table 3.2: Methods used to inspect variables.

Method	Description
IsArray	Is the parameter an array?
IsEmpty	Is the parameter an uninitialized variant type?
IsNull	Does the parameter contain “no” data?
IsObject	Is the parameter an OLE object?
IsUnoStruct	Is the parameter an UNO structure?
TypeName	What is the type name of the parameter?

A variables type name can also provide information as to a variables properties.

Table 3.3: Values returned by the TypeName() statement.

Type	TypeName()
Variant	“Empty” or name of contained object
Object	“Object” even if it is null. Same for structures.
regular type	regular type name such as “String”
array	name followed by “()”

Listing 3.8 demonstrates the statements in Table 3.2, and Figure 3.1 shows a portion of the output.

Listing 3.8: Inspect variables.

Sub TypeTest

Dim oSimpleFileAccess

Dim aProperty As New com.sun.star.beans.Property

oSimpleFileAccess = CreateUnoService( "com.sun.star.ucb.SimpleFileAccess" )

Dim v, o As Object, s As String, ss$, a(4) As String

ss = "Empty Variant: " & GetSomeObjInfo(v) & chr(10) &_

"Empty Object: " & GetSomeObjInfo(o) & chr(10) &_

"Empty String: " & GetSomeObjInfo(s) & chr(10)

v = 4

ss = ss & "int Variant: " & GetSomeObjInfo(v) & chr(10)

v = o

ss = ss & "null obj Variant: " & GetSomeObjInfo(v) & chr(10) &_

"struct: " & GetSomeObjInfo(aProperty) & chr(10) &_

"service: " & GetSomeObjInfo(oSimpleFileAccess) & chr(10) &_

"array: " & GetSomeObjInfo(a())

MsgBox ss, 64, "Type Info"

End Sub

REM Returns basic type information for the parameter.

REM This also returns the dimensions of an array.

Function GetSomeObjInfo(vObj) As String

Dim s As String

s = "TypeName = " & TypeName(vObj) & CHR$(10) &_

"VarType = " & VarType(vObj) & CHR$(10)

If IsNull(vObj) Then

s = s & "IsNull = True"

ElseIf IsEmpty(vObj) Then

s = s & "IsEmpty = True"

Else

If IsObject(vObj) Then

On Local Error GoTo DebugNoSet

s = s & "Implementation = " & NotSafeGetImplementationName(vObj) & CHR$(10)

DebugNoSet:

On Local Error Goto 0

s = s & "IsObject = True" & CHR$(10)

End If

If IsUnoStruct(vObj) Then s = s & "IsUnoStruct = True" & CHR$(10)

If IsDate(vObj) Then s = s & "IsDate = True" & CHR$(10)

If IsNumeric(vObj) Then s = s & "IsNumeric = True" & CHR$(10)

If IsArray(vObj) Then

On Local Error Goto DebugBoundsError:

Dim i%, sTemp$

s = s & "IsArray = True" & CHR$(10) & "range = ("

Do While (i% >= 0)

i% = i% + 1

sTemp$ = LBound(vObj, i%) & " To " & UBound(vObj, i%)

If i% > 1 Then s = s & ", "

s = s & sTemp$

Loop

DebugBoundsError:

On Local Error Goto 0

s = s & ")" & CHR$(10)

End If

End If

GetSomeObjInfo = s

End Function

REM This places an error handler where it will catch the problem

REM and return something anyway!

Function SafeGetImplementationName(vObj) As String

On Local Error GoTo ThisErrorHere:

SafeGetImplementationName = NotSafeGetImplementationName(vObj)

Exit Function

ThisErrorHere:

On Local Error GoTo 0

SafeGetImplementationName = "*** Unknown ***"

End Function

REM The problem is that if this Function is called and the vObj type does

REM NOT support the getImplementationName() call, then I receive an

REM "Object variable not set" error at the Function definition.

Function NotSafeGetImplementationName(vObj) As String

NotSafeGetImplementationName = vObj.getImplementationName()

End Function

Figure 3.1: Type information for different types of variables.

What Can This Object Do?

Both a service and a structure have a type name of “Object”. For a structure, you need to know what kind so that you can find the supported properties – use the API website to check the IDL. UNO objects, on the other hand, usually support the ServiceInfo, which provides information about the service. The getImplementationName() object method returns the fully qualified name of the object. Use the fully qualified name to search Google or the Developer's Guide for more information. The getSupportedServiceNames() object method returns a sequence of all interfaces supported by the object. A common method finding out what an object can do is to call the following three methods:

Listing 3.9: What can this object do?

MsgBox vObj.dbg_methods 'The methods supported by this object.

MsgBox vObj.dbg_supportedInterfaces 'The interfaces supported by this object.

MsgBox vObj.dbg_properties 'The properties supported by this object.

OOo includes macros to display debug information. The most commonly used included macros are PrintdbgInfo(object) and ShowArray(object). The WritedbgInfo(object) macro inserts object debug information into an open writer document.

Languages other than Basic

StarBasic provides numerous conveniences not provided by other programming languages. This section touches on only a few of these.

CreateUnoService

The CreateUnoService() method is a short cut to obtaining the global service manager and then calling createInstance() on the service manager.

Listing 3.10: Get the global process service manager.

oManager = GetProcessServiceManager()

oDesk = oManager.createInstance("com.sun.star.frame.Desktop")

In StarBasic, this process may be done in a single step – unless you need to use createInstanceWithArguments() that is.

Listing 3.11: CreateUnoService is less code than using the process service manager.

oDesk = CreateUnoService("com.sun.star.frame.Desktop")

Other languages, such as Visual Basic, do not support the CreateUnoService() method.

Listing 3.12: Create a UNO service using Visual Basic.

Rem Visual Basic does not support CreateUnoService().

Rem The service manager is always the first thing to create In Visual Basic.

Rem If OOo is not running, it is started.

Set oManager = CreateObject("com.sun.star.ServiceManager")

Rem Create a desktop object.

Set oDesk = oManager.createInstance("com.sun.star.frame.Desktop")

ThisComponent

In StarBasic, ThisComponent references the current the document, or the document that caused a macro to be called. ThisComponent is set once when the macro is started, and does not change, even if the macro causes a new document to become current – this includes closing ThisComponent. Even with the pitfalls, ThisComponent is a nice convenience. In languages other than Basic, the common solution is to use the getCurrentComponent() on the desktop object. Unfortunately, this will not return a document object if the Basic IDE or the help window is current, but this is less likely when a language other than Basic is used.

There are times when you might want to use StarDesktop.getCurrentComponent() rather than simply using ThisComponent, but your macro will fail when run from the Basic IDE.

StarDesktop

In StarBasic, StarDesktop references the desktop object; you do not need to create a desktop object. In other languages, you must explicitly create a desktop object.

Accessing methods and properties

StarBasic automatically makes the methods and properties supported by an object available – StarBasic sometimes makes properties available that are not available using other methods. In other languages, the interface that defines the method that you want to call must be extracted before it can be used (see Listing 3.13).

Listing 3.13: In Java, you must obtain an interface before you can use it.

XDesktop xDesktop = (XDesktop) UnoRuntime.queryInterface(XDesktop.class, desktop);

XFrame xFrame = (XFrame) xDesktop.getCurrentFrame();

XDispatchProvider oProvider;

oProvider = (XDispatchProvider) UnoRuntime.queryInterface(XdispatchProvider.class, xFrame);

If the view cursor is in a text section, then the TextSection property on the view cursor contains a reference to the text section. If not, then the TextSection property is null. In StarBasic, I might obtain the text section as follows:

Listing 3.14: OOo Basic allows you to access properties directly.

If IsNull(oDoc.CurrentController.getViewCursor().TextSection) Then

In a language other than StarBasic, the CurrentController property and the TextSection property are not directly available. The current controller is available using a “get” method, and the text section is available as a property value.

Listing 3.15: Access some properties using get methods.

If IsNull(oDoc.getCurrentController().getViewCursor().getPropertyValue("TextSection")) Then

Code that uses the get and set methods is easier to translate into other languages. StarBasic also allows certain properties to act as an array, even if the property is not an array. The Sheets property in a Calc document is a good example of this. In Calc, both of the following accomplish the same thing, but only the second example may work outside of StarBasic.

Listing 3.16: OOo Basic allows you to access some properties as an array.

oDoc.sheets(1)

oDoc.getSheets().getByIndex(1)

Examples

Debugging And Inspecting Macros

It can be difficult to determine what methods and properties are available for an object. The methods in this section should help.

Determine Document Type

In OOo, most of the functionality is defined by services. To determine the document type, look at the services it supports. The macro shown below uses this method. I assume that this is safer than calling ThisComponent.getImplementationName().

Listing 4.1: Identify most OpenOffice.org document types.

'Author: Included with OpenOffice

Function GetDocumentType(oDoc)

On Local Error GoTo NODOCUMENTTYPE

If oDoc.SupportsService("com.sun.star.sheet.SpreadsheetDocument") Then

GetDocumentType() = "scalc"

ElseIf oDoc .SupportsService("com.sun.star.text.TextDocument") Then

GetDocumentType() = "swriter"

ElseIf oDoc .SupportsService("com.sun.star.drawing.DrawingDocument") Then

GetDocumentType() = "sdraw"

ElseIf oDoc .SupportsService("com.sun.star.formula.FormulaProperties") Then

GetDocumentType() = "smath"

ElseIf oDoc .SupportsService("com.sun.star.presentation.PresentationDocument") Then

GetDocumentType() = "simpress"

End If

NODOCUMENTTYPE:

If Err <> 0 Then

GetDocumentType = ""

Resume GOON

GOON:

End If

End Function

I usually check the document type before performing document specific actions. The macro in Listing 4.2 by Alain Viret [Alain.Viret@bger.admin.ch] returns the name of the PDF export filter based on the document type.

Listing 4.2: Use the document type to determine the PDF export filter.

Function GetPDFFilter(oDoc)

On Local Error GoTo NODOCUMENTTYPE

If oDoc.SupportsService("com.sun.star.presentation.PresentationDocument") Then

GetPDFFilter() = "impress_pdf_Export"

ElseIf oDoc.SupportsService("com.sun.star.sheet.SpreadsheetDocument") Then

GetPDFFilter() = "calc_pdf_Export"

ElseIf oDoc.SupportsService("com.sun.star.text.TextDocument") Then

GetPDFFilter() = "writer_pdf_Export"

ElseIf oDoc.SupportsService("com.sun.star.drawing.DrawingDocument") Then

GetPDFFilter() = "draw_pdf_Export"

ElseIf oDoc.SupportsService("com.sun.star.formula.FormulaProperties") Then

GetPDFFilter() = "math_pdf_Export"

End If

NODOCUMENTTYPE:

If Err <> 0 Then

GetPDFFilter = ""

Resume GOON

GOON:

End If

End Function

Tip	Listing 4.1 does not identify an Impress document, Listing 4.2 does.

Display Object Methods And Properties

The following Subroutine displays the names of either the supported methods or properties of an object. If the second parameter is the empty string, the method names are printed in a dialog. Any other value and the property names are printed. Because the displayed list is frequently very long, the list is displayed in manageable chunks.

Listing 4.3: Display methods, interfaces, or properties of an object.

'******************************************************************

'A subroutine to display all the methods or properties of an input

'Author: Tony Bloomfield

'email: tonyb.lx@btinternet.com

'Modified: hal@thresholddigital.com to support services and to check if oObj exists

Sub DisplayMethods(oObj as Object, SWhat as String)

Dim sMethodLIst as String, sMsgBox as String

Dim fs, ep as Integer

Dim i as INteger

Dim EOL as Boolean

If IsNull(oObj) Then

Print "Object does not exist."

Else

If sWhat = "m" Then

sMethodList = oObj.DBG_Methods

ElseIf sWhat = "s" Then

sMethodList = oObj.DBG_SupportedInterfaces

ElseIf sWhat = "p" Then

sMethodLIst = oObj.DBG_Properties

End If

fs = 1

EOL = FALSE

While fs <= Len(sMethodList)

sMsgBox = ""

For i = 0 to 15

ep = InStr(fs, sMethodList, ";")

If ep = 0 then

ep = Len(sMethodList)

End If

sMsgBox = sMsgBox & Mid$(sMethodList, fs, ep - fs) & chr$(13)

fs = ep + 1

Next i

MsgBox sMsgBox

Wend

End If

End Sub

Display Object Properties In Spreadsheet

This macro creates a new spreadsheet document and then populates the sheets with object information. I extensively modified this macro because it used global variables. The global variables interfered with my own local variables. This prevented me from using this in my existing code.

Tip	Use Global Variables only when necessary. If variables can be passed as an argument, this is usually preferred.

Listing 4.4: Display object properties in a Calc document.

'******************************************************************

'Author: Hermann Kienlein

'email: info@kienlein.com

'online: http://www.kienlein.com/pages/oo.html

Option Explicit ' Force every variable to be declared

Sub Main

MainObjectDisplay(ThisComponent)

End Sub

' ------------------------------------------------------

'Create a new spreadsheet document and then create new sheets in the

'document. Give the sheets names and insert information into these sheets.

Sub MainObjectDisplay(oObject As Object)

Dim oInfo As Object, oDeskNeu As Object, oNewDoc As Object

Dim sNewUrl As String, nSheetsUsed As Long

Dim sInterfaces As String

Dim NoArgs()

nSheetsUsed = 0

oDeskNeu = createUnoService("com.sun.star.frame.Desktop")

'sNewUrl = "staroffice.factory:scalc" ' This did not work

sNewUrl = "private:factory/scalc"

oNewDoc = oDeskNeu.loadComponentFromURL( sNewUrl,"_blank",0,NoArgs())

ObjInfo(oNewDoc, nSheetsUsed, "ThisComponent", oObject)

On Local Error GoTo AllDone

sInterfaces = oObject.dbg_supportedinterfaces

On Local Error GoTo NoController

If InStr(sInterfaces, "com.sun.star.frame.XModel") <> 0 Then

oInfo = oObject.getCurrentController()

ObjInfo(oNewDoc, nSheetsUsed, "getCurrentController", oInfo)

End If

NoController:

On Local Error GoTo NoDocInfo

'??

' If InStr(sInterfaces, "com.sun.star.document.XDocumentInfoSupplier") <> 0 Then

oInfo = oObject.getDocumentInfo()

ObjInfo(oNewDoc, nSheetsUsed, "getDocumentInfo", oInfo)

' End If

NoDocInfo:

On Local Error GoTo NoSelection

'??

' If InStr(sInterfaces, "com.sun.star.frame.XSelectionSupplier") <> 0 Then

oInfo = oObject.getCurrentSelection()

ObjInfo(oNewDoc, nSheetsUsed, "getCurrentSelection", oInfo)

' End If

NoSelection:

On Local Error GoTo NoLibraryContainer

If InStr(sInterfaces, "com.sun.star.script.XStarBasicAccess") <> 0 Then

oInfo = oObject.getLibraryContainer()

ObjInfo(oNewDoc, nSheetsUsed, "getLibraryContainer", oInfo)

End If

NoLibraryContainer:

On Local Error GoTo NoViewData

If InStr(sInterfaces, "com.sun.star.document.XViewDataSupplier") <> 0 Then

oInfo = oObject.getViewData()

ObjInfo(oNewDoc, nSheetsUsed, "getViewData", oInfo)

End If

NoViewData:

On Local Error GoTo NoEvents

If InStr(sInterfaces, "com.sun.star.document.XEventsSupplier") <> 0 Then

oInfo = oObject.getEvents()

ObjInfo(oNewDoc, nSheetsUsed, "getEvents", oInfo)

End If

NoEvents:

AllDone:

On Local Error GoTo 0

End Sub

' ------------------------------------------------------

Sub ObjInfo(oDoc As Object, nSheetsUsed&, sSheetName$, obj As Object)

Dim i2 As Integer, bProp As Boolean

Dim nRow&, nCol&, oSheet As Object

nRow = 0

ncol = 0

'on error goto err_ObjInfo

If Not isNull(obj) Then

GoToNextSheet(oDoc, nSheetsUsed, sSheetName)

oSheet = oDoc.Sheets.getByIndex(nSheetsUsed-1)

'oCell.String=CStr(obj.WindowServiceName)

SetCell(nCol, nRow, oSheet, TypeName(obj), 1, 0)

SetCell(nCol, nRow, oSheet, VarType(obj), -1, 2)

i2 = InStr(obj.dbg_methods,"getPropertySetInfo")

If i2 > 0 Then

bProp = true

Else

bProp = false

End If

ListItems (nCol, nRow, obj.dbg_methods, ";", obj, true, oSheet)

MoveRow(nCol, nRow, 2)

If Not isNull (obj.dbg_properties) Then

'NextSheet()

ListItems (nCol, nRow, obj.dbg_properties, ";", obj, false, oSheet)

End If

If bProp Then

GetProps(nCol, nRow, obj, oSheet)

bProp = false

End If

MoveRow(nCol, nRow, 1)

ListItems (nCol, nRow, obj.dbg_supportedinterfaces, chr$(10), obj, false, oSheet)

'CleanDbg 'noch keine Ahnung, für was das gut ist

'NextSheet()

End If

exit_ObjInfo:

Exit Sub

err_ObjInfo:

'Print err

If err=423 Then

obName = inputbox("Das Objekt hat keine name-Eigenschaft."_

+" Welchen Namen soll das neue Tabellenblatt haben?")

Resume Next

Else

msgbox error$, 16

Resume exit_ObjInfo

End If

End Sub

' ------------------------------------------------------

' ListItems - search passed String for special characters, like LineBreaks and output them line after line.

' ------------------------------------------------------

Sub ListItems(nCol&, nRow&, itemstring$, sep$, oBj As Object, gt As Boolean, oSheet As Object)

'Dim oCurs As Object

Dim frag As String, sleft As String, sPrf As String

Dim act As Integer, ex As Integer, nextpos As Integer

Dim nextchr As Integer, lstr As Integer, lfrag As Integer

Dim ch As Integer

lstr = Len(itemstring)

act =1

'Everything left of the first colon

SetCell(nCol, nRow, oSheet, Left(itemstring,InStr(1,itemstring, ":")), 0, 0)

'If there is no colon, then we are done here

If InStr(1,itemstring,":") < 1 Then

SetCell(nCol, nRow, oSheet, itemstring, 0, 0)

Exit Sub

End If

act= act+InStr(1,itemstring,":") 'also jetzt auf dem ersten :

'act = act+1 'ein Zeichen weiter positionieren

MoveRow(nCol, nRow, 1)

While act<lstr

nextpos=InStr(act,itemstring,sep) 'Position des ersten ; nach :

frag = Mid(itemstring,act,nextpos-act)

lfrag = Len(frag)

act=act+lfrag+1

frag = LTrim(frag) 'linksbündig ausrichten

If frag > "" Then

Do

nextchr = Asc(Mid(frag,1,1)

If nextchr = "10" Then

Mid(frag,1,1," ")

frag = LTrim(frag) 'linksbündig ausrichten

Else

exit Do

End If

Loop

End If

MoveRow(nCol, nRow, 1)

SetCell(nCol, nRow, oSheet, frag, 0, 0)

If gt Then

GtVal(nCol, nRow, frag,oBj, oSheet)

End If

Wend

itemstring = ""

End Sub

' ------------------------------------------------------

' Sub um Properties auszulesen, Object muß allerdins

' .PropertySetInfo.Methode

' unterstützen

Sub GetProps(nCol&, nRow&, obj, oSheet As Object)

Dim vVariant as Variant

Dim nVar As Integer

Dim mProperties as variant

Dim mProps1 as variant

Dim sItemDescription

Dim nCount As Integer

Dim iP As Integer, iP1 As Integer

Dim n$

Dim p

Dim tmp$

Dim j%

Dim vItem

Dim sString

MoveRow(nCol, nRow, 2)

mProperties = obj.PropertySetInfo.Properties

nCount = UBound(mProperties)-LBound(mProperties) + 2

SetCell(nCol, nRow, oSheet, "Properties With Values", 0, 1)

SetCell(nCol, nRow, oSheet, "Name", 1, 0)

SetCell(nCol, nRow, oSheet, "Value", -1, 1)

For iP = LBound(mProperties) To UBound(mProperties)

p = mProperties(iP)

n$ = p.name

vVariant = obj.getPropertyValue(n$)

SetCell(nCol, nRow, oSheet, n$, 1, 0)

nVar = VarType(vVariant)

Select Case nVar

Case 1 'isNull

SetCell(nCol, nRow, oSheet, "NULL-VALUE", 0, 1)

Case 9 'object

If Not isNull (vVariant.dbg_properties) Then

ListItems (nCol, nRow, vVariant.dbg_properties, ";", vVariant, false, oSheet)

MoveRow(nCol, nRow, 2)

End If

if not isNull (vVariant.dbg_supportedinterfaces) then

ListItems (nCol, nRow, vVariant.dbg_supportedinterfaces, _

chr$(10), vVariant, false, oSheet)

MoveRow(nCol, nRow, 2)

End If

If Not isNull (vVariant.dbg_methods) Then

ListItems (nCol, nRow, vVariant.dbg_methods, ";", _

vVariant, false, oSheet)

MoveRow(nCol, nRow, 2)

End If

Case Else

If IsArray(vVariant) Then

tmp$ = ""

For j% = LBound(vVariant) To UBound(vVariant)

vItem = vVariant(j%)

If IsNull(vItem) Then

sItemDescription = "NULL-Value"

ElseIf IsObject(vItem) Then

If Not isNull(vItem.dbg_properties) Then

sItemDescription = CStr(vItem.dbg_properties)

End If

Else

sItemDescription = cstr(vItem)

End If

tmp$ = tmp$ & sItemDescription

Next j%

ListItems(nCol, nRow, tmp$,";",vVariant,false, oSheet)

Else

SetCell(nCol, nRow, oSheet, cstr(vVariant), 0, 1)

End If

end select

MoveRow(nCol, nRow, 1)

MoveCol(nCol, nRow, -1)

Next iP

End Sub

' ------------------------------------------------------

' GetValue - Inhalte auslesen

' ------------------------------------------------------

Sub GtVal (nCol&, nRow&, sGVal As String, oBje As Object, oSheet As Object)

Dim is1 As Integer, iAr As Integer

Dim s1 As String, s2 As String, s3 As String

Dim aR1(10) as variant

Dim o1 As Object

is1 =InStr(sGVal," ") 'erstes Space suchen

s1 = Mid(sGval,1,is1)

s2 = Mid(sGVal,1,is1," ")

sGVal = LTrim(sGVal)

is1 = InStr(sGVal," ")

s2 = Mid(sGVal,1,is1)

s1 = LTrim(s1)

s1= RTrim(s1)

s2 = LTrim(s2)

s2 = RTrim(s2)

Select Case s1

Case "SbxSTRING"

Select Case s2

Case "getURL"

s3 = oBje.getURL()

Case "getLocation"

s3 = oBje.getLocation()

Case "getImplementationName"

s3 = oBje.getImplementationName()

Case "getUserFieldName"

s3 = oBje.getUserFieldName(0)

Case "getUserFieldValue"

s3 = oBje.getUserFieldValue(0)

Case Else

s3 = s2

End Select

's3 = oBje.&s2

'msgbox(CStr(oBje)&s2)

MoveCol(nCol, nRow, 4)

SetCell(nCol, nRow, oSheet, s3, -4, 0)

Case "SbxBOOL"

Select Case s2

Case "hasControllersLocked"

s3= CStr(oBje.hasControllersLocked())

Case "isModified"

s3= CStr(oBje.isModified())

Case "AutoloadEnabled"

s3= CStr(oBje.AutoloadEnabled())

Case "hasElements"

s3= CStr(oBje.hasElements())

Case "IsEncrypted"

s3= CStr(oBje.IsEncrypted())

Case "isReadonly"

s3= CStr(oBje.isReadonly())

Case Else

s3 = " "

End Select

MoveCol(nCol, nRow, 4)

SetCell(nCol, nRow, oSheet, s3, -4, 0)

Case "SbxINTEGER"

Select Case s2

Case "getUserFieldCount"

s3 = CStr(oBje.getUserFieldCount())

Case "EditingCycles"

s3 = CStr(oBje.EditingCycles())

Case Else

s3 = ""

End Select

MoveCol(nCol, nRow, 4)

SetCell(nCol, nRow, oSheet, s3, -4, 0)

Case "SbxLONG"

Select Case s2

Case "getCount"

s3 = CStr(oBje.getCount())

Case Else

s3 = ""

End Select

MoveCol(nCol, nRow, 4)

SetCell(nCol, nRow, oSheet, s3, -4, 0)

Case "SbxOBJECT"

Select Case s2

Case "getElementType"

s3 = CStr(VarType(oBje.getElementType()))

MoveCol(nCol, nRow, 4)

SetCell(nCol, nRow, oSheet, s3, -4, 0)

Case "getText"

o1 = oBje.getText()

MoveCol(nCol, nRow, 4)

SetCell(nCol, nRow, oSheet, o1.dbg_properties, 3, 0)

SetCell(nCol, nRow, oSheet, o1.dbg_methods, -7, 0)

Case Else

End Select

Case "SbxARRAY"

Select Case s2

Case "getImplementationId"

aR1() = oBje.getImplementationId()

MoveCol(nCol, nRow, 4)

For iAr = LBound(oBje.getImplementationID()) To _

UBound(oBje.getImplementationID())

s3 = CStr(aR1(iAr))

SetCell(nCol, nRow, oSheet, s3, 1, 0)

next iAr

MoveCol(nCol, nRow, -(4+1+UBound(oBje.getImplementationID())))

Case "getArgs"

'?? Why is this commented out to print?

aR1() = oBje.getArgs()

MoveCol(nCol, nRow, 4)

'For iAr = LBound(oBje.getArgs()) To UBound(oBje.getArgs())

For iAr = LBound(aR1()) To UBound(aR1())

o1 = aR1(iAr) s3 = o1.dbg_properties

'GetProps(aR1(iAr)

'oCell.String = s3

MoveCol(nCol, nRow, 1)

Next iAr

MoveCol(nCol, nRow, -(4+1+UBound(oBje.getArgs())))

Case "getTypes"

aR1() = oBje.getTypes()

MoveCol(nCol, nRow, 4)

For iAr = LBound(oBje.getTypes()) To UBound(oBje.getTypes())

o1 = aR1(iAr)

s3 = VarType(o1)

SetCell(nCol, nRow, oSheet, s3, 1, 0)

Next iAr

MoveCol(nCol, nRow, -(4+1+UBound(oBje.getTypes())))

Case "getElementNames"

aR1() = oBje.getElementNames()

MoveCol(nCol, nRow, 4)

For iAr = LBound(oBje.getElementNames()) To _

UBound(oBje.getElementNames())

'o1 = aR1(iAr)

's3 = VarType(o1)

SetCell(nCol, nRow, oSheet, aR1(iAr), 1, 0)

Next iAr

MoveCol(nCol, nRow, -(4+1+UBound(oBje.getElementNames())))

Case "getSupportedServiceNames"

aR1() = oBje.getSupportedServiceNames()

MoveCol(nCol, nRow, 4)

For iAr = LBound(oBje.getSupportedServiceNames()) To _

UBound(oBje.getSupportedServiceNames())

'o1 = aR1(iAr)

's3 = VarType(o1)

SetCell(nCol, nRow, oSheet, aR1(iAr), 1, 0)

Next iAr

MoveCol(nCol, nRow, _

-(4+1+UBound(oBje.getSupportedServiceNames())))

Case "getPrinter"

aR1() = oBje.getPrinter()

MoveCol(nCol, nRow, 4)

For iAr = LBound(oBje.getPrinter()) To UBound(oBje.getPrinter())

o1 = aR1(iAr)

s3 = CStr(VarType(aR1(iAr)))

'?? We never print this

MoveCol(nCol, nRow, 1)

Next iAr

MoveCol(nCol, nRow, -(4+1+UBound(oBje.getPrinter())))

Case Else

s3 = " "

MoveCol(nCol, nRow, 4)

SetCell(nCol, nRow, oSheet, s3, -4, 0)

End Select

Case Else

s3 = " "

MoveCol(nCol, nRow, 4)

SetCell(nCol, nRow, oSheet, s3, -4, 0)

End Select

end sub

' -----------------------------------------------------

Sub SetCell(nCol&, nRow&, oSheet As Object, s$, colInc%, rowInc%)

oSheet.getCellByPosition(nCol, nRow).String = s$

If colInc <> 0 Then MoveCol(nCol, nRow, colInc%)

If rowInc <> 0 Then MoveRow(nCol, nRow, rowInc)

End Sub

' ------------------------------------------------------

Sub MoveCol(nCol&, nRow&, i%)

nCol = nCol + i

If nCol < 0 Then

nRow = nRow + 1

nCol = 0

End If

End Sub

' ------------------------------------------------------

Sub MoveRow(nCol&, nRow&, i%)

nRow = nRow + i

If nRow < 0 Then

nRow = 0

End If

End Sub

' ------------------------------------------------------

'Create a new sheet if required with the given name.

Sub GoToNextSheet(oDoc As Object, nSheetsUsed&, sSheetName$, Optional nWhichSheet%)

Dim oSheets As Object, oSheet As Object

oSheets = oDoc.Sheets

If isNumeric(nWhichSheet) Then

oSheets.insertNewByName("Sheet"&CStr(oSheets.Count()+1), nWhichSheet)

oSheet = oSheet.getByIndex(nWhichSheet)

Else

If nSheetsUsed > oSheets.Count() - 1 Then

nSheetsUsed = oSheets.Count() - 1

oSheets.insertNewByName("Sheet"&CStr(oSheets.Count()+1), _

nSheetsUsed)

End If

oSheet = oSheets.getByIndex(nSheetsUsed)

nSheetsUsed = nSheetsUsed + 1

End If

oSheet.Name = sSheetName

End Sub

A Better Way To Do It

Bernard Marcelly wrote a tool called X-Ray, which displays information concerning an object in a dialog. The ease of the X-Ray tool has caused widespread acceptance of the tool. The X-Ray tool is available for download from http://www.ooomacros.org/dev.php. X-Ray is highly recommended by many people!

I do not use X-Ray because I wrote a similar tool before X-Ray was written. My original tool, the SimpleObjectBrowser, is available in the Pitonyak library on my web site. More recently, I created an Object inspector for my book “OpenOffice.org Macros Explained” – unfortunately, you must purchase the book to get a copy of my object inspector. The publisher's page is shown below, but the book is also available from Amazon.com.

http://www.hentzenwerke.com/catalogpricelists/oome.htm

Dispatch: Using Universal Network Objects (UNO)

http://udk.openoffice.org and the Developer's Guide are good references in your quest to understand UNO. UNO is a component model offering interoperability between different programming languages, object models, machine architectures, and processes.

On the Windows platforms, many software packages use the existing COM. OOo, however, has its own mult-iplatform component object model. By using its own object model, OOo's functionality is not limited to Windows. Secondly, OOo can provide a better error handling system than is provided by COM. Nevertheless, COM can still be used to control OpenOffice (Windows). For more information, see http://api.openoffice.org/docs/DevelopersGuide/ProfUNO/ProfUNO.htm#1+4+4+Automation+Bridge.

This example dispatches an UNO command to perform the “undo” command using the OLD dispatch mechanism. !!!Remove the older methods!!!.

Listing 4.5: Use older outdated dispatch method to perform the undo operation.

Sub UnoUndo

PerformDispatch(ThisComponent.CurrentController.Frame, ".uno:Undo")

End Sub

Sub PerformDispatch(oObj As Object, uno$)

Dim oParser As Object

Dim oUrl As New com.sun.star.util.URL

Dim oDisp As Object

REM The UNO service is represented as a URL

oUrl.Complete = uno$

REM Parse the URL as required

oParser = createUnoService("com.sun.star.util.URLTransformer")

oParser.parseStrict(oUrl)

REM See if the current Frame supports this UNO command

oDisp = oObj.queryDispatch(oUrl,"",0)

If (Not IsNull(oDisp)) Then

oDisp.dispatch(oUrl,noargs())

Else

MsgBox uno$ & " was not found"

End If

End Sub

Starting in release 1.1, this can be written as

Listing 4.6: Use the new dispatch method to perform the undo operation.

Sub Undo

Dim oDisp as object

oDisp = createUnoService("com.sun.star.frame.DispatchHelper")

oDisp.executeDispatch(ThisComponent.CurrentController.Frame,".uno:Undo", "", 0, Array())

End Sub

The difficult part is knowing the UNO interface and the parameters for each. Consider the following which should work with newer versions of OOo.

Listing 4.7: Use the new dispatch method to export a Write document to PDF.

Dim args1(2) As New com.sun.star.beans.PropertyValue

Dim args2(0) As New com.sun.star.beans.PropertyValue

args1(0).Name = "URL"

args1(0).Value = "my_file_name_.pdf"

args1(1).Name = "FilterName"

args1(1).Value = "writer_pdf_Export"

oDisp.executeDispatch(document, ".uno:ExportDirectToPDF", "", 0, args1())

Listing 4.8: Use the new dispatch method to go to a cell, copy, and paste.

REM position to B3

args2(0).Name = "ToPoint"

args2(0).Value = "$B$3"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args2())

dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())

dispatcher.executeDispatch(document, ".uno:Paste", "", 0, Array())

The Dispatcher Changed In Version 1.1

Hal Vaughan asked: “Is it just me, or is there a reason the dispatcher won't work with most functions under 1.0.3?” Mathias Bauer answered.

The dispatcher uses some functionality not present in OOo1.0 (dispatch helper). The code to execute a dispatch with parameters, for example.

Will Dispatch Names Change?

This is another Hal Vaughan question and Mathias Bauer answered:

Macros using dispatch names rather than numbers will not change between OOo versions.

Using the dispatcher requires a user interface.

Yet another Hal Vaughan question and Mathias Bauer answer.

Is there any reason to use the regular API calls instead of calling the dispatcher with the function name?

Dispatch calls do not work on a document without a UI. If OOo is run in a real "server" mode (something that could happen in the OOo2.0 release) where documents can be loaded and scripted without any GUI, only macros using the “real” API will work. The real API is also much more powerful and gives you a better insight in the real objects. IMHO you should use the dispatch API only for two reasons:

Recording macros

As a workaround when a certain task can not be done by any “real” API (because it does not exist or it is broken).

Modifying the menu – a dispatcher example

As of OpenOffice.org 1.1.1, it is not possible to assign a macro to a menu item using the API – this should be possible in version 2.0:

http://specs.openoffice.org/ui_in_general/api/ProgrammaticControlOfMenuAndToolbarItems.sxw

The API IDL states that there is an XMenu Interface and also an XMenuListener. Retrieving the Menu ID from the XML file that defines the menu is possible, assigning a macro to that ID is not – still waiting for OOo 2.0! This is possible now, however, using a DispatchProviderInterceptor, which can be compared to a Listener or Handler.

With a DispatchProviderInterceptor we can listen for Dispatch commands. It is possible to intercept almost every command. Using the slot ids, we can assign macros to special DispatchCommands that represent menu items. Although we can not prevent a user from selecting a menu item, we can intercept the command when it is dispatched. A DispatchInterceptor must be implemented and registered.

The ToggleToolbarVisibility macro, written by Peter Biela on the oooforum, toggles the visibility of tool bars on and off.

Listing 4.9: Toggle the visibility of a tool bar.

Author: Peter Biela

E-Mail : Peter.Biela@planet-interkom.de

Sub ToggleToolbarVisibility( )

Dim oFrame

Dim oDispatcher

oFrame = ThisComponent.CurrentController.Frame

oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

oDispatcher.executeDispatch(oFrame, ".uno:MenuBarVisible", "", 0, Array())

oDispatcher.executeDispatch(oFrame, ".uno:ObjectBarVisible", "", 0, Array())

oDispatcher.executeDispatch(oFrame, ".uno:OptionBarVisible", "", 0, Array())

oDispatcher.executeDispatch(oFrame, ".uno:NavigationBarVisible", "", 0, Array())

oDispatcher.executeDispatch(oFrame, ".uno:StatusBarVisible", "", 0, Array())

oDispatcher.executeDispatch(oFrame, ".uno:ToolBarVisible", "", 0, Array())

oDispatcher.executeDispatch(oFrame, ".uno:MacroBarVisible", "", 0, Array())

oDispatcher.executeDispatch(oFrame, ".uno:FunctionBarVisible", "", 0, Array())

'on CalcFrames

oDispatcher.executeDispatch(oFrame, ".uno:InputLineVisible", "", 0, Array())

End Sub

Intercept menu commands using Basic

Paolo Mantovani discovered that you can intercept menu commands from Basic. It was assumed that you could not because the language does not support the creation of custom UNO objects. I, Andrew Pitonyak, would like to point out that this is not the first time that Paolo Mantovani has managed to accomplish something that was claimed to be impossible.

Listing 4.10: Intercept menu commands.

REM Author: Paolo Mantovani

Option Explicit

Global oDispatchInterceptor

Global oSlaveDispatchProvider

Global oMasterDispatchProvider

Global oFrame

Global bDebug As Boolean

'________________________________________________________

Sub RegisterInterceptor

oFrame = ThisComponent.currentController.Frame

oDispatchInterceptor = _

CreateUnoListener("ThisFrame_", "com.sun.star.frame.XDispatchProviderInterceptor")

oFrame.registerDispatchProviderInterceptor(oDispatchInterceptor)

End Sub

'________________________________________________________

Sub ReleaseInterceptor()

On Error Resume Next

oFrame.releaseDispatchProviderInterceptor(oDispatchInterceptor)

End Sub

'________________________________________________________

Function ThisFrame_queryDispatch ( oUrl As Object, sTargetFrameName As String,

lSearchFlags As Long ) As Variant

Dim oDisp

'the slot protocol causes ooo crash...

If oUrl.protocol = "slot:" Then

Exit Function

End If

If bDebug Then

Print oUrl.complete, sTargetFrameName, lSearchFlags

End If

oDisp = _

oSlaveDispatchProvider.queryDispatch( oUrl, sTargetFrameName, lSearchFlags )

'do your management here

Select Case oUrl.complete

Case ".uno:Save" 'disable the save command

Exit Function

'Case "..."

'...

Case Else

' do nothing

End Select

ThisFrame_queryDispatch = oDisp

End Function

'________________________________________________________

Function ThisFrame_queryDispatches ( mDispArray ) As Variant

ThisFrame_queryDispatches = mDispArray

End Function

'________________________________________________________

Function ThisFrame_getSlaveDispatchProvider ( ) As Variant

ThisFrame_getSlaveDispatchProvider = oSlaveDispatchProvider

End Function

'________________________________________________________

Sub ThisFrame_setSlaveDispatchProvider ( oSDP )

oSlaveDispatchProvider = oSDP

End Sub

'________________________________________________________

Function ThisFrame_getMasterDispatchProvider ( ) As Variant

ThisFrame_getMasterDispatchProvider = oMasterDispatchProvider

End Function

'________________________________________________________

Sub ThisFrame_setMasterDispatchProvider ( oMDP )

oMasterDispatchProvider = oMDP

End Sub

'________________________________________________________

Sub ToggleDebug()

'be carefull! you will have a debug message

' for each dispatch....

bDebug = Not bDebug

End Sub

Miscellaneous Examples

Display Text In Status Bar

Listing 5.1: Display text in the status bar, but it will not change.

'******************************************************************

'Author: Sasa Kelecevic

'email: scat@teol.net

'Here are two methods that may be used to obtain the

'status indicator

Function ProgressBar

ProgressBar = ThisComponent.CurrentController.StatusIndicator

End Function

REM display text in status bar

Sub StatusText(sInformation as String)

Dim iLen As Integer

Dim iRest as Integer

iLen = Len(sInformation)

iRest = 270-iLen

ProgressBar.start(sInformation+SPACE(iRest),0)

End Sub

According to Christian Erpelding [erpelding@ce-data.de], using the above code, you can only change the status bar ONCE and then all changes to the status bar are ignored. Use setText rather than start as shown below.

Listing 5.2: Display text in the status bar.

Sub StatusText(sInformation)

Dim iLen as Integer

Dim iRest As Integer

iLen=Len(sInformation)

iRest=350-iLen

REM This uses the ProgressBar function shown above!

ProgressBar.setText(sInformation+SPACE(iRest))

End Sub

Display All Styles In The Current Document

This is not as exciting as it appears. The following styles exist for a text document: CharacterStyles, FrameStyles, NumberingStyles, PageStyles, and ParagraphStyles.

Listing 5.3: Display all of the styles used in the current document.

'******************************************************************

'Author: Andrew Pitonyak

'email: andrew@pitonyak.org

Sub DisplayAllStyles

Dim mFamilyNames As Variant, mStyleNames As Variant

Dim sMsg As String, n%, i%

Dim oFamilies As Object, oStyle As Object, oStyles As Object

oFamilies = ThisComponent.StyleFamilies

mFamilyNames = oFamilies.getElementNames()

For n = LBound(mFamilyNames) To UBound(mFamilyNames)

sMsg = ""

oStyles = oFamilies.getByName(mFamilyNames(n))

mStyleNames = oStyles.getElementNames()

For i = LBound(mStyleNames) To UBound (mStyleNames)

sMsg=sMsg + i + " : " + mStyleNames(i) + Chr(13)

If ((i + 1) Mod 21 = 0) Then

MsgBox sMsg,0,mFamilyNames(n)

sMsg = ""

End If

Next i

MsgBox sMsg,0,mFamilyNames(n)

Next n

End Sub

Iterate Through All Open Documents

Listing 5.4: Iterate through all of the open documents.

Sub Documents_Iteration( )

Dim oDesktop As Object, oDocs As Object

Dim oDoc As Object, oComponents As Object

Dim i as Integer 'i counts how many windows are open in OOo

i = 0

oComponents = StarDesktop.getComponents()

oDocs = oComponents.createEnumeration()

Do While oDocs.hasMoreElements()

oDoc = oDocs.nextElement()

i = i + 1 'Counter

Loop

MsgBox i + "Components are currently open"

End Sub

List Fonts And Other Screen Information

Thanks to Paul Sobolik, I finally have a working example. First you create an abstract window toolkit and then you create a virtual device compatible with the screen. From this device, you can obtain things such as the screen dimensions and font information.

Tip	When designing a font, it is common to generate a version for different display attributes such as bold or italic. When you list the fonts supported by your system, you will frequently find all of the variations. Windows contains “Courier New Regular”, “Courier New Italic”, “Courier New Bold”, and “Courier New Bold Italic”.

See Also:
http://api.openoffice.org/docs/common/ref/com/sun/star/awt/XToolkit.html
http://api.openoffice.org/docs/common/ref/com/sun/star/awt/XDevice.html
http://api.openoffice.org/docs/common/ref/com/sun/star/awt/FontDescriptor.html

Listing 5.5: List available fonts.

'Author: Paul Sobolik

'email: psobolik@lycos.com

Sub ListFonts

Dim oToolkit as Object

oToolkit = CreateUnoService("com.sun.star.awt.Toolkit")

Dim oDevice as Variant

oDevice = oToolkit.createScreenCompatibleDevice(0, 0)

Dim oFontDescriptors As Variant

oFontDescriptors = oDevice.FontDescriptors

Dim oFontDescriptor As Object

Dim sFontList as String

Dim iIndex as Integer, iStart As Integer, iTotal As Integer, iAdjust As Integer

iTotal = UBound(oFontDescriptors) - LBound(oFontDescriptors) + 1

iStart = 1

iAdjust = iStart - LBound(oFontDescriptors)

For iIndex = LBound(oFontDescriptors) To UBound(oFontDescriptors)

oFontDescriptor = oFontDescriptors(iIndex)

sFontList = sFontList & iIndex + iAdjust & ": " & oFontDescriptor.Name & " " &_

oFontDescriptor.StyleName & Chr(10)

If ((iIndex + iAdjust) Mod 20 = 0) Then

MsgBox sFontList, 0, "Fonts " & iStart & " to " & iIndex + iAdjust & " of " & iTotal

iStart = iIndex + iAdjust + 1

sFontList = ""

End If

Next iIndex

If sFontList <> "" Then MsgBox sFontList, 0, "Fonts " & iStart & " to " & iIndex & " of " & iTotal

End Sub

Note that it depends on your Operating System (also on its settings) which Fonts are supported.

Display supported fonts

Set the default font using the ConfigurationProvider

To change the default font, run the macro and then restart OOo.

Listing 5.6: Set the default font using the ConfigurationProvider.

Author: Christian Junker

Sub DefaultFont_Change()

Dim nodeArgs(0) As New com.sun.star.beans.PropertyValue

Dim s

REM Properties

nodeArgs(0).Name = "nodePath"

nodeArgs(0).Value = "org.openoffice.Office.Writer/DefaultFont"

nodeArgs(0).State = com.sun.star.beans.PropertyState.DEFAULT_VALUE

nodeArgs(0).Handle = -1 'no handle!

REM the required Config Services

Provider = createUnoService("com.sun.star.comp.configuration.ConfigurationProvider")

s = "com.sun.star.configuration.ConfigurationUpdateAccess"

UpdateAccess = Provider.createInstanceWithArguments(s, nodeArgs())

REM set your DefaultFont now..

UpdateAccess.Standard = "Arial"

UpdateAccess.Heading = "Arial"

UpdateAccess.List = "Arial"

UpdateAccess.Caption = "Arial"

UpdateAccess.Index = "Arial"

UpdateAccess.commitChanges()

End Sub

Print Current Document

I played with this and I can print. I stopped trying to figure out how to print an A4 document on my Letter printer! I wanted to set this by default but I decided that it is not worth my time for now.

Listing 5.7: Print the current document.

'******************************************************************

'Author: Andrew Pitonyak

'email: andrew@pitonyak.org

Sub PrintCurrentDocument

Dim mPrintopts1(), x as Variant

'Dimensioned at 0, if you set any other properties, be certain to set this to a higher value....

Dim mPrintopts2(0) As New com.sun.star.beans.PropertyValue

Dim oDocument As Object, oPrinter As Object

oDocument = ThisComponent

'***********************************

'Do you want to choose a certain printer

'Dim mPrinter(0) As New com.sun.star.beans.PropertyValue

'mPrinter(0).Name="Name"

'mPrinter(0).value="Other printer"

'oDocument.Printer = mPrinter()

'***********************************

'To simply print the document do the following:

'oDocument.Print(mPrintopts1())

'***********************************

'To print pages 1-3, 7, and 9

'mPrintopts2(0).Name="Pages"

'mPrintopts2(0).Value="1-3; 7; 9"

'oDocument.Printer.PaperFormat=com.sun.star.view.PaperFormat.LETTER

'DisplayMethods(oDocument, "propr")

'DisplayMethods(oDocument, "")

oPrinter = oDocument.getPrinter()

MsgBox "printer is from " + LBound(oPrinter) + " to " + UBound(oPrinter)

sMsg = ""

For n = LBound(oPrinter) To UBound(oPrinter)

sMsg = sMsg + oPrinter(n).Name + Chr(13)

Next n

MsgBox sMsg,0,"Print Settings"

'DisplayMethods(oPrinter, "propr")

'DisplayMethods(oPrinter, "")

'mPrintopts2(0).Name="PaperFormat"

'mPrintopts2(0).Value=com.sun.star.view.PaperFormat.LETTER

'oDocument.Print(mPrintopts2())

End Sub

Print Current Page

Listing 5.8: Print only the current page.

Dim aPrintOps(0) As New com.sun.star.beans.PropertyValue

oDoc = ThisComponent

oViewCursor = oDoc.CurrentController.getViewCursor()

aPrintOps(0).Name = "Pages"

aPrintOps(0).Value = trim(str(oViewCursor.getPage()))

oDoc.print(aPrintOps())

Other Printing Arguments

Another parameter to consider is the Wait parameter set to True. This causes printing to be synchronous and the call does not return until after printing is finished. This removes the requirement of a listener when printing is finished; assuming that you wanted to use one anyway.

Landscape

Listing 5.9: Print the document in landscape mode.

Sub PrintLandscape()

Dim Printeroptions(1) as new com.sun.star.beans.PropertyValue

Printeroptions(0).Name = "Name"

Printeroptions(0).Value = "<insert_your_printername_here>"

Printeroptions(1).Name = "PaperOrientation"

Printeroptions(1).Value = com.sun.star.view.PaperOrientation.LANDSCAPE

ThisComponent.Printer = Printeroptions()

End Sub

Configuration information

OOo version

Unfortunately, the function GetSolarVersion frequently stays the same even when the versions change. Version 1.0.3.1 returns “641” and 1.1RC3 returns 645, but this is not always enough granularity. The following macro returns the actual OOo version.

Listing 5.10: Obtain the current OpenOffice.org version.

Function OOoVersion() As String

'Retrieves the running OOo version

'Author : Laurent Godard

'e-mail : listes.godard@laposte.net

'

Dim aSettings, aConfigProvider

Dim aParams2(0) As New com.sun.star.beans.PropertyValue

Dim sProvider$, sAccess$

sProvider = "com.sun.star.configuration.ConfigurationProvider"

sAccess = "com.sun.star.configuration.ConfigurationAccess"

aConfigProvider = createUnoService(sProvider)

aParams2(0).Name = "nodepath"

aParams2(0).Value = "/org.openoffice.Setup/Product"

aSettings = aConfigProvider.createInstanceWithArguments(sAccess, aParams2())

OOOVersion=aSettings.getByName("ooSetupVersion")

End Function

OOo Locale

Listing 5.11: Obtain the current OpenOffice.org locale.

Function OOoLang() as string

'Author : Laurent Godard

'e-mail : listes.godard@laposte.net

'

Dim aSettings, aConfigProvider

Dim aParams2(0) As New com.sun.star.beans.PropertyValue

Dim sProvider$, sAccess$

sProvider = "com.sun.star.configuration.ConfigurationProvider"

sAccess = "com.sun.star.configuration.ConfigurationAccess"

aConfigProvider = createUnoService(sProvider)

aParams2(0).Name = "nodepath"

aParams2(0).Value = "/org.openoffice.Setup/L10N"

aSettings = aConfigProvider.createInstanceWithArguments(sAccess, aParams2())

Dim OOLangue as string

OOLangue= aSettings.getbyname("ooLocale") 'en-US

OOLang=lcase(Left(trim(OOLangue),2)) 'en

End Function

Open And Close Documents (And The Desktop)

Close OpenOffice And/Or Documents

All OpenOffice.org documents and frame objects (services) support the XCloseable interface. To close these objects you must call close(bForce As Boolean). Generally speaking, if bForce is false, the object may refuse to close, otherwise it can not refuse. I say generally speaking, because anything that has registered to listen for close events may veto a document close. When you tell OOo to print a document, control is returned before printing is finished. If you were then able to close the document, well, OOo would probably crash. Refer to the Developer's Guide for a more complete description of the XClosable interface, and if you are uncertain which to use, use close(True).

The desktop object does not support the XCloseable interface for legacy reasons. The terminate() method is used for this. This method causes a queryTermination-event to be broadcast to all listeners. If no TerminationVetoException is thrown, a notifyTermination-event is broadcast and true is returned. If not, an abortTermination-event is broadcast and false is returned. To quote Mathias Bauer, “the terminate() method was already there for a longer time, long before we discovered that it is not the right way to handle closing documents or windows. If this method hadn't been there, we would have used XCloseable for the desktop also.”[Bauer001]

Listing 5.12: Proper method to close an OpenOffice.org document.

If oDoc.supportsService("com.sun.star.frame.XModel")

If HasUnoInterfaces(oDoc, "com.sun.star.util.XCloseable") Then

oDoc.close(true)

Else

oDoc.dispose()

End If

End If

Christian Junker adds the following:

There are many issues with properly closing a document or killing the soffice process. Using the method StarDesktop.terminate() does not kill the process!).

Use oDoc.close(true), unless you have “exceptional” framework issues.

Avoid oDoc.dispose()! A disposed document may still be visible, but you can not manipulate it in any way. Even referencing the document using ThisComponent can lead to an error, because the Document's Model does not exist.

OOo version 2.0 should provide an improved Framework, especially for the close methods.

What if the file is modified?

I always assume that the document supports the close method. In other words, I assume that I am using a newer version of OpenOffice.org. I want to avoid any dialogs, so I check to see if the document has been modified. If I can store the document, then I try to do this.

Listing 5.13: Close a document that is modified

If (ThisComponent.isModified) Then

If (ThisComponent.hasLocation AND (Not ThisComponent.isReadOnly)) Then

ThisComponent.store()

Else

ThisComponent.setModified(False)

End If

End If

ThisComponent.close(True)

Load A Document From A URL

To load a document from a URL, use the LoadComponentFromURL() method from the desktop. This loads a component into either a new or an existing frame.

Syntax:

loadComponentFromURL(
string aURL,
string aTargetFrameName,
long nSearchFlags,
sequence< com::sun::star::beans::PropertyValue > aArgs)

Returns:

com::sun::star::lang::XComponent

Parameters:

aURL: URL of the document to load. To create a new document, use "private:factory/scalc", "private:factory/swriter", etc.

aTargetFrameName: Name of the frame that will contain the document in. If a frame with the name exists, it is used, otherwise it is created. "_blank" creates a new frame, "_self" uses the current frame, "_parent" uses the parent of frame, and "_top" uses the top frame of the current path in the tree.

nSearchFlags: Use the values of FrameSearchFlag to specify how to find the specified aTargetFrameName . Normally, simply use 0 . http://api.openoffice.org/docs/common/ref/com/sun/star/frame/FrameSearchFlag.html

Table 5.1: Frame search flags.

#	Name	Description
0	Auto	SELF+CHILDREN
1	PARENT	Includes the parent frame
2	SELF	Includes the start frame
4	CHILDREN	Include the child frames of the start frame
8	CREATE	Frame will be created if not found
16	SIBLINGS	Include the other child frames of the parent of the start frame
32	TASKS	Include all frames in all tasks in the current frames hierarchy
23	ALL	Include all frames not in other tasks. 23 = 1+2+4+16 = PARENT + SELF + CHILDREN + SIBLINGS.
55	GLOBAL	Search entire hierarchy of frames. 55 = 1+2+4+16+32 = PARENT + SELF + CHILDREN + SIBLINGS + TASKS.
63		GLOBAL + CREATE

aArgs: Specify component or filter specific behavior. "ReadOnly" with a boolean value specifies whether the document is opened read-only. "FilterName" specifies the component type to create and the filter to use, for example: "scalc: Text - csv". See http://api.openoffice.org/docs/common/ref/com/sun/star/document/MediaDescriptor.html

Listing 5.14: Load a document from a given URL.

REM Frame "MyName" will be created if it does not exist because it includes "CREATE"

oDoc1 = StarDesktop.LoadComponentFromUrl(sUrl_1, "MyName", 63, Array())

REM Use existing Frame "MyName"

oDoc2 = StarDesktop.LoadComponentFromUrl(sUrl_2, "MyName", 55, Array())

Tip	In 1.1 the frame implements loadComponentFromURL so you can use: oDoc = oDesk.LoadComponentFromUrl(sUrl_1, "_blank", 0, Noargs()) oFrame = oDoc.CurrentController.Frame oDoc = oFrame.LoadComponentFromUrl(sUrl_2, "", 2, Noargs()) Note the search flag arguments and the empty frame name argument.
Warning	In 1.1 you can only reuse a frame if you know its name.

Listing 5.15: Insert a document at the current cursor.

Sub insertDocumentAtCursor(sFileUrl As String, oText As Object, oDoc As Object)

Dim oCur

oCur=oText.createTextCursorByRange(oDoc.getCurrentController().getViewCursor().getStart())

oCur.insertDocumentFromURL(sFileURL, Array())

End Sub

Listing 5.16: Create a new document.

'------------- create a new Writer file --------------------

'oDocNew=StarDesktop.loadComponentFromURL("private:factory/swriter","_blank",0,Array())

------------- open an existing file ---------------

'oDocOldFile=StarDesktop.loadComponentFromURL(sUrl,"_blank",0,Array())

A complete example

The purpose of this example, is to cycle through three documents titled one, two, and three. Each document is opened into the current frame.

Listing 5.17: Load a document into an existing frame.

Sub open_new_doc

Dim mArgs(2) as New com.sun.star.beans.PropertyValue

Dim oDoc

Dim oFrame

Dim s As String

If (ThisComponent.isModified) Then

If (ThisComponent.hasLocation AND (Not ThisComponent.isReadOnly)) Then

ThisComponent.store()

Else

ThisComponent.setModified(False)

End If

End If

mArgs(0).Name = "ReadOnly"

mArgs(0).Value = True

mArgs(1).Name = "MacroExecutionMode"

mArgs(1).Value = 4

mArgs(2).Name = "AsTemplate"

mArgs(2).Value = FALSE

REM Choose the next document to load

If ThisComponent.hasLocation Then

s = ThisComponent.getURL()

If InStr(s, "one") <> 0 Then

s = "file:///C:/tmp/two.oxt"

ElseIf InStr(s, "two") <> 0 Then

s = "file:///C:/tmp/three.oxt"

Else

s = "file:///C:/tmp/one.oxt"

End If

Else

s = "file:///C:/tmp/one.oxt"

End If

REM Get the document's frame and then load the specified document

REM into the current frame!

oFrame = ThisComponent.getCurrentController().getFrame()

oDoc = oFrame.LoadComponentFromUrl(s, "", 2, mArgs())

If IsNull(oDoc) OR IsEmpty(oDoc) Then

Print "Unable to load " & s

End If

End Sub

Create a new document from a template

To create a new document based on a template use the following:

Listing 5.18: Create a new document from a template.

Sub NewDoc

Dim oDoc

Dim sPath$

Dim FileProperties(0) As New com.sun.star.beans.PropertyValue

FileProperties(0).Name = "AsTemplate"

FileProperties(0).Value = true

sPath$ = "file://~/Documents/DocTemplate.stw"

oDoc = StarDesktop.LoadComponentFromUrl(sPath$, "_blank" , 0, FileProperties())

End Sub

If you want to edit the template as a template, set “AsTemplate” to “False”.

Warning	After loading a document as hidden, you should not make the document visible because not all of the required services are initialized. This can cause OOo to crash. Hopefully this will be fixed in OOo version 2.0 .

How do I Enable Macros With LoadComponentFromURL

When a document is loaded by a macro, the contained macros are disabled. This is a security issue. As of version 1.1, you can enable macros when the document is loaded. Set the property “MacroExecutionMode” to either 2 or 4 and it should will work. I base this on an email on the dev mailing list. Thank You Mikhail Voitenko <Mikhail.Voitenko@Sun.COM>

http://www.openoffice.org/servlets/ReadMsg?msgId=782516&listName=dev

I condensed his reply:

There is a 'MediaDescriptor' property 'MacroExecutionMode', that uses values from the '::com::sun::star::document::MacroExecMode' constants. If this property is not specified, the

default behavior forbids macro execution. Supported constant values are found at the link below: http://api.openoffice.org/source/browse/api/offapi/com/sun/star/document/MacroExecMode.idl?rev=1.5&content-type=text/x-cvsweb-markup

Table 5.2: Media descriptor property when loading a document.

#	Name	Description
0	NEVER_EXECUTE	Never Execute
1	FROM_LIST	Execute macros from list; warning output is specified by configuration.
2	ALWAYS_EXECUTE	A macro should be executed always; warning output is specified by configuration.
3	USE_CONFIG	Use configuration to retrieve macro settings. In case a user confirmation is required a dialog is output.
4	ALWAYS_EXECUTE_NO_WARN	A macro should be executed always no warning should be produced.
5	USE_CONFIG_REJECT_CONFIRMATION	Use configuration to retrieve macro settings. Treat cases when user confirmation required as rejected.
6	USE_CONFIG_APPROVE_CONFIRMATION	Use configuration to retrieve macro settings. Mean cases when user confirmation required as approved.

There are a few caveats to watch for. If you load a document "AsTemplate" the document is not opened, it is created. You must have events bound to “create document” rather “open document”. To cover both cases, bind the macro to both events.

Listing 5.19: Examples setting media descriptor properties.

Dim mFileProperties(1) As New com.sun.star.beans.PropertyValue

mFileProperties(0).Name="AsTemplate"

mFileProperties(0).Value=True

mFileProperties(1).Name="MacroExecutionMode"

mFileProperties(1).Value=4

This should work for macros configured to "OnNew" (Create Document), if you load a template or an sxw (but I have not tried it). If you use "OnLoad" (Open Document), you must set "AsTemplate" to False (or use an sxw file, because this defaults to False, where as templates (stw) default to True).

In OOo version 2.0, the Macro security is likely to be expanded.

Error handling on load

When a document fails to load a message is displayed providing information concerning the failed load. When the document is loaded from C++, it is possible that no exceptions will be thrown, so you will not be aware of the error.

Mathias Bauer explained that the XComponentLoader interface is not able to throw arbitrary exceptions so the “Interaction Handler” concept is used. When a document is loaded via loadComponentFromURL, an “InteractionHandler” is passed in the arguments array. The GUI provides a UI based Interaction Handler that converts the errors into a user interaction such as displaying an error message or prompting for a password (see the Developer's Guide for a few examples). If an Interaction Handler is not provided, a default handler is used. The default handler catches all exceptions and re-throws the few that may be thrown from loadComponentFromURL. Although it is not possible to implement your own interaction handler using Basic, the Developer's Guide has examples in other languages.

Mail Merge example, merge all documents in a directory

A mail merge creates a separate document for each merged record. This utility retrieves all write documents in a directory and creates a single output file that contains all of the documents combined into one. I modified the original macro so that all variables are declared and this works even if the first file found is not a Writer document.

Listing 5.20: Merge all documents in a single directory into one.

'author: Laurent Godard

'Modified by: Andrew Pitonyak

Sub MergeDocumentsInDirectory()

' On Error Resume Next

Dim DestDirectory As String

Dim FileName As String

Dim SrcFile As String, DstFile As String

Dim oDesktop, oDoc, oCursor, oText

Dim argsInsert()

Dim args()

'Remove the following comments to do things hidden

'Dim args(0) As New com.sun.star.beans.PropertyValue

'args(0).name="Hidden"

'args(0).value=true

'Which desitnation directory?

DestDirectory=Trim(GetFolderName())

If DestDirectory = "" Then

MsgBox "No directory selected, exiting",16,"Merging Documents"

Exit Sub

End If

REM force a trailing backslash. This is okay because using URL notation

If Right(DestDirectory,1) <> "/" Then

DestDirectory=DestDirectory & "/"

End If

oDeskTop=CreateUnoService("com.sun.star.frame.Desktop")

REM Read the first file!

FileName=Dir(DestDirectory)

DstFile = ConvertToURL(DestDirectory & "ResultatFusion.sxw")

Do While FileName <> ""

If lcase(right(FileName,3))="sxw" Then

SrcFile = ConvertToURL(DestDirectory & FileName)

If IsNull(oDoc) OR IsEmpty(oDoc) Then

FileCopy( SrcFile, DstFile )

oDoc=oDeskTop.Loadcomponentfromurl(DstFile, "_blank", 0, Args())

oText = oDoc.getText

oCursor = oText.createTextCursor()

Else

oCursor.gotoEnd(false)

oCursor.BreakType = com.sun.star.style.BreakType.PAGE_BEFORE

oCursor.insertDocumentFromUrl(SrcFile, argsInsert())

End If

End If

FileName=dir()

Loop

If IsNull(oDoc) OR IsEmpty(oDoc) Then

MsgBox "No documents merged!",16,"Merging Documents"

Exit Sub

End If

'Save the document

Dim args2()

oDoc.StoreAsURL(DestDirectory & "ResultatFusion.sxw",args2())

If HasUnoInterfaces(oDoc, "com.sun.star.util.XCloseable") Then

oDoc.close(true)

Else

oDoc.dispose()

End If

'Reload the document!

oDoc=oDeskTop.Loadcomponentfromurl(DstFile,"_blank",0,Args2())

End Sub

Creating A Table

The following macro demonstrates handling text tables and the contained cells.

Listing 5.21: Create a text table and insert cells.

Author: Hermann Kienlein

Author: Christian Junker

Sub easyUse( )

Dim odoc, otext, ocursor, mytable, tablecursor

odoc = thisComponent

otext = odoc.getText()

mytable = CreateTable(odoc)

'create normal TextCursor

ocursor = otext.CreateTextCursor()

ocursor.gotoStart(false)

'now that we defined the range = position of the table, let's insert it

otext.insertTextContent(ocursor, myTable, false )

tablecursor = myTable.createCursorByCellName("A1")

InsertNextItem("first cell", tablecursor, mytable) 'insert a new item:

InsertNextItem("second cell", tablecursor, mytable) 'and another one:

End Sub

Sub InsertNextItem(what, oCursor, oTable)

Dim oCell As Object

'name of the cell range that is selected by this cursor

sName = oCursor.getRangeName()

' The cell name will be something like D3

oCelle = oTable.getCellByName(sName)

oCelle.String = what

oCursor.goRight(1,FALSE)

End Sub

Function CreateTable(document) As Object

oTextTable = document.createInstance("com.sun.star.text.TextTable")

oTextTable.initialize(5, 8)

oTextTable.HoriOrient = 0 'com::sun::star::text::HoriOrientation::NONE

oTextTable.LeftMargin = 2000

oTextTable.RightMargin = 1500

CreateTable = oTextTable

End Function

Sub deleteTables()

'sometimes deleting tables in the GUI seems kind of silly,

'this procedure will delete all tables

Dim enum, textobject

enum = thisComponent.Text.createEnumeration

While enum.hasMoreElements()

txtcontent = enum.nextElement()

If txtcontent.supportsService("com.sun.star.text.TextTable") Then

thisComponent.Text.removetextcontent(txtcontent)

End If

Wend

End Sub

A table with no borders

Lalaimia Samia <samia.lalaimia@infotel.com> asked me how to insert a table into a document that contained no borders. You can not manipulate borders of a table until after it has been inserted. The next problem is that each of the properties is a structure so it is not possible to directly modify the structure because you are only modifying a copy. The answer is to copy the structure to a temporary variable, modify the temporary variable, and then copy the temporary variable back. This is tedious but simple.

Listing 5.22: Insert a text table with no borders.

Sub InsertATableWithNoBorders

Dim oTable 'Newly created table to insert

REM Let the document create the text table.

oTable = ThisComponent.createInstance( "com.sun.star.text.TextTable" )

oTable.initialize(4, 1) 'Four rows, one column

REM Now insert the text table at the end of the document.

ThisComponent.Text.insertTextContent(ThisComponent.Text.getEnd(), oTable, False)

Dim x 'represents each BorderLine

Dim v 'represents the TableBorder Object as a whole

v = oTable.TableBorder

x = v.TopLine

x.OuterLineWidth = 0

v.TopLine = x

x = v.LeftLine

x.OuterLineWidth = 0

v.LeftLine = x

x = v.RightLine

x.OuterLineWidth = 0

v.RightLine = x

x = v.TopLine

x.OuterLineWidth = 0

v.TopLine = x

x = v.VerticalLine

x.OuterLineWidth = 0

v.VerticalLine = x

x = v.HorizontalLine

x.OuterLineWidth = 0

v.HorizontalLine = x

x = v.BottomLine

x.OuterLineWidth = 0

v.BottomLine = x

oTable.TableBorder = v

oTable.setDataArray(Array(Array("Files"), Array("One"), Array("Two"), Array("Three"), ))

End Sub

Loading/Inserting a graphic into your document

This is a simple task that is difficult to figure out until you know that the inserted object must be created using createInstance(“object”) by the document. The graphic is inserted as a link into the document. The following macro inserts a text graphic object as a link to the existing document. This is a text graphics object, which is inserted at a cursor position. Although you must set the graphic size, you do not need to set the position.

Listing 5.23: Insert a GraphicsObject into a document as a link.

Sub InsertGraphicObject(oDoc, sURL$)

REM Author: Andrew Pitonyak

Dim oCursor

Dim oGraph

Dim oText

oText = oDoc.getText()

oCursor = oText.createTextCursor()

oCursor.goToStart(FALSE)

oGraph = oDoc.createInstance("com.sun.star.text.GraphicObject")

With oGraph

.GraphicURL = sURL

.AnchorType = com.sun.star.text.TextContentAnchorType.AS_CHARACTER

.Width = 6000

.Height = 8000

End With

'now insert the image into the text document

oText.insertTextContent( oCursor, oGraph, False )

End Sub

You can also insert a graphics object shape, which is inserted into the draw page rather than at a cursor location. You must, therefore set the location and the size.

Listing 5.24: Insert a GraphicsObjectShape into the draw page.

Sub InsertGraphicObjectShape(oDoc, sURL$)

REM Author: Andrew Pitonyak

Dim oSize As New com.sun.star.awt.Size

Dim oPos As New com.sun.star.awt.Point

Dim oGraph

REM First, create a graphic object shape

oGraph = oDoc.createInstance("com.sun.star.drawing.GraphicObjectShape")

REM Size and place the graphic object.

oSize.width=6000

oSize.height=8000

oGraph.setSize(oSize)

oPos.X = 2540

oPos.Y = 2540

oGraph.setposition(oPos)

REM Assuming a text document, add it to the single draw page.

oDoc.getDrawpage().add(oGraph)

REM Set URL to the graphic.

oGraph.GraphicURL = sURL

End Sub

Tip	An inserted graphic can be contained in the document, or outside of the document. In either case, the GraphicURL always links to the graphic. If the object is not inserted as a link, then then URL stars with the text “vnd.sun.star.GraphiObject:”. Graphic objects inserted using the API are inserted as links – they are not embedded into the document Danny Brewer, however, figured out how to get around this, as mentioned shortly.

Convert a linked graphic to an embedded graphic.

To insert an embedded graphic into a document, it must first be inserted as a link and then changed to an embedded object. Unfortunately, I only know how to do this using a drawing graphic, not a text graphic. This is unfortunate, because I have a strong preference for a text graphic in a Writer document so that I can anchor it as a character. The following macro was used while traversing the text content, to convert linked graphics into embedded graphics.

Listing 5.25: Insert a linked GraphicsObjectShape into the draw page.

Sub EmbedLinkedGraphic(oGraph)

REM Author: Andrew Pitonyak

Dim sGraphURL As String

Dim oGraph_2

Dim oCurs

Dim oText

Dim oAnchor

If InStr(oGraph.GraphicURL, "vnd.sun") <> 0 Then

REM Ignore an image that is already embedded

Exit Sub

End If

If oGraph.supportsService("com.sun.star.drawing.GraphicObjectShape") Then

REM I only know how to convert a GraphicObjectShape.

REM I do not know how to convert a TextGraphicObject,

REM but it is probably related to the ImageMap attribute.

oAnchor = oGraph.getAnchor()

oText = oAnchor.getText()

oGraph_2 = ThisComponent.createInstance("com.sun.star.drawing.GraphicObjectShape")

oGraph_2.GraphicObjectFillBitmap = oGraph.GraphicObjectFillBitmap

oGraph_2.Size = oGraph.Size

oGraph_2.Position = oGraph.Position

oText.insertTextContent(oAnchor, oGraph_2, False)

oText.removeTextContent(oGraph)

End If

End Sub

Danny Brewer embeds a graphic

Danny Brewer figured out how to load a bitmap into the document and then obtain the URL of the loaded bitmap. The com.sun.star.drawing.BitmapTable service loads the image.

Listing 5.26: Insert the image into the internal bitmap table.

REM Given a URL to an external graphic resource,

REM load that graphic permanently into this drawing document,

REM and return a new URL to the internal resource.

REM The new URL can be used in place of the old URL.

Function LoadGraphicIntoDocument( oDoc As Object, cUrl$, cInternalName$ ) As String

Dim oBitmaps

Dim cNewUrl As String

' Get the BitmapTable from this drawing document.

' It is a service that maintains a list of bitmaps that are internal

' to the document.

oBitmaps = oDoc.createInstance( "com.sun.star.drawing.BitmapTable" )

' Add an external graphic to the BitmapTable of this document.

oBitmaps.insertByName( cInternalName, cUrl )

' Now ask for it back.

' What we get back is an different Url that points to a graphic

' which is inside this document, and remains with the document.

cNewUrl = oBitmaps.getByName( cInternalName )

LoadGraphicIntoDocument = cNewUrl

End Function

Loading the bitmap into the document does not display the bitmap. The internal bitmap can be used with either Listing 5.23 or Listing 5.24 to insert a graphic that is stored inside of the document. The following macro inserts the same graphic using two different methods. Either will work, depending upon whether you desire an embedded or a linked graphic. Note that oBitmaps.getByName(“DBGif”) returns the URL of the embedded image in the form vnd.sun.star.GraphicObject:<big hex number>.

Listing 5.27: You can insert as an external or an internal link.

Dim sURL$

Dim oBitmaps

REM Insert a reference to the external file

sURL = "file:///andrew0/home/andy/db.gif"

InsertGraphicObject(ThisComponent, sURL)

REM Insert a reference to an internally contained graphic.

oBitmaps = ThisComponent.createInstance( "com.sun.star.drawing.BitmapTable" )

LoadGraphicIntoDocument(ThisComponent, sURL, "DBGif")

InsertGraphicObject(ThisComponent, oBitMaps.getByName("DBGif"))

Embed a graphics using a dispatch

A dispatch can easily embed a graphic into a document.

Listing 5.28: Embed a graphic into a document.

Dim oFrame

Dim oDisp

Dim args1(1) as new com.sun.star.beans.PropertyValue

oFrame = ThisComponent.CurrentController.Frame

oDisp = createUnoService("com.sun.star.frame.DispatchHelper")

args1(0).Name = "FileName"

args1(0).Value = "file:///<YOURPATH>/<YOURFILE>"

args1(1).Name = "AsLink"

args1(1).Value = False

oDisp.executeDispatch(oFrame, ".uno:InsertGraphic", "", 0, args1())

Embed a graphics directly

The following method, requires OOo version 2.0 or later. I do not have the time to explain how it works, but it is certainly useful.

Listing 5.29: Embed a graphic into a document.

Sub EmbedGraphic(oDoc, sURL$)

REM Author: Stephan Wunderlich

Dim oShape

Dim oGraph 'The graphic object is text content.

Dim oProvider 'GraphicProvider service.

Dim oText

oShape = oDoc.createInstance("com.sun.star.drawing.GraphicObjectShape")

oGraph = oDoc.createInstance("com.sun.star.text.GraphicObject")

oDoc.getDrawPage().add(oShape)

oProvider = createUnoService("com.sun.star.graphic.GraphicProvider")

Dim oProps(0) as new com.sun.star.beans.PropertyValue

oProps(0).Name = "URL"

oProps(0).Value = sURL

oShape.Graphic = oProvider.queryGraphic(oProps())

oGraph.graphicurl = oShape.graphicurl

oText= oDoc.getText()

' Insert at the current cursor location

oText.insertTextContent(oDoc.getCurrentController().getViewCursor(), oGraph, false)

' We no longer require the shape object.

oDoc.getDrawPage().remove(oShape)

End Sub

Setting Margins

The following macro assumes a text document. Draw and Impress documents use the BorderLeft method of the draw page.

Listing 5.30: Set the margins by modifying the text style.

Sub Margins( )

Dim oStyleFamilies, oFamilies, oPageStyles, oStyle, oViewCursor, oPageStyleName

Dim fromleft%, fromtop%, fromright%, frombottom%

Dim oDoc

oDoc = ThisComponent

REM you don't need the Textviewcursor, you can also use the normal TextCursor

oViewCursor = oDoc.CurrentController.getViewCursor()

oPageStyleName = oViewCursor.PageStyleName

oPageStyles = oDoc.StyleFamilies.getByName("PageStyles")

oStyle = oPageStyles.getByName(oPageStyleName)

REM fromleft, fromtop, fromright, frombottom = whatever you want

oStyle.LeftMargin = fromleft

oStyle.TopMargin = fromtop

oStyle.RightMargin = fromright

oStyle.BottomMargin = frombottom

End Sub

To remove manually applied margins, set the properties ParaFirstLineIndent and ParaLeftMargin to zero.

Setting the paper size

Setting the page size automatically sets the paper type.

Listing 5.31: Set the page size using the Width and Height properties.

Sub SetThePageStyle()

Dim oStyle

Dim sPageStyleName$

Dim oDoc

Dim s$

oDoc = ThisComponent

REM you don't need the Textviewcursor, you can also use the normal TextCursor

sPageStyleName = oDoc.getCurrentController().getViewCursor().PageStyleName

oStyle = oDoc.StyleFamilies.getByName("PageStyles").getByName(sPageStyleName)

'Inspect(oStyle.Size)

REM Is this is Letter, then set to A4

If oStyle.Width = 27940 Then

Print "Setting to size A4"

oStyle.Width = 21000

oStyle.Height = 29700

Else

Print "Setting to size Letter"

oStyle.Width = 21590

oStyle.Height = 27940

End If

REM Note that the Width and Height properties are the same as the

REM values stored in the Size property. Seems silly, I know...

REM Setting the width or height sets both...

s = "Width = " & CStr(oStyle.Width / 2540) & " inches" & CHR$(10) & _

"Height = " & CStr(oStyle.Height / 2540) & " inches" & CHR$(10) & _

"Width = " & CStr(oStyle.Size.Width / 2540) & " inches" & CHR$(10) & _

"Height = " & CStr(oStyle.Size.Height / 2540) & " inches" & CHR$(10)

MsgBox s, 0, "Page Style " & sPageStyleName

End Sub

Calling an external program (Internet Explorer) using OLE

Use the Shell command or the OleObjectFactory (for Windows only).

Listing 5.32: Use the OleObjectFactory to start an application.

Sub using_IE( )

Dim oleService

Dim IE

oleService = createUnoService("com.sun.star.bridge.OleObjectFactory")

IE = oleService.createInstance("InternetExplorer.Application.1")

IE.Visible = 1

IE.Navigate("http://www.openoffice.org")

End Sub

Use the Shell command for files containing spaces

See the section on URL Notation! To summarize, use a %20 where the space should be.

Listing 5.33: You must use URL notation for spaces with the shell command.

Sub ExampleShell

Shell("file:///C|/Andy/My%20Documents/oo/tmp/h.bat",2)

Shell("C:\Andy\My%20Documents\oo\tmp\h.bat",2)

End Sub

The ConvertToUrl and ConvertFromUrl conveniently convert between URL notation and the notation used by your operating system – use these methods, they will save you time.

The third argument to the Shell function is the argument that is passed to the called program. The fourth argument, called bSync, determines if the shell command will wait until the shell process completes (bSync = True), or if the shell command returns immediately (bSync = False). The default value is False. If two consecutive Shell statements do not set the bSync argument to True, the second Shell statement is likely to be run before the first command has finished.

Read And Write Number In File

This shows how to read and write a string from a text file. The string is converted to a number and incremented. The number is then written back out to the file as a string.

Listing 5.34: Read and write a number in a file.

'******************************************************************

'Author: Andrew Pitonyak

'email: andrew@pitonyak.org

Sub Read_Write_Number_In_File

Dim CountFileName As String, NumberString As String

Dim LongNumber As Long, iNum As Integer

CountFileName = "C:\Andy\My Documents\oo\NUMBER.TXT"

NumberString = "00000000"

LongNumber = 0

If FileExists(CountFileName) Then

ON ERROR GOTO NoFile

iNum = FreeFile

OPEN CountFileName for input as #iNum

LINE INPUT #iNum ,NumberString

CLOSE #iNum

MsgBox("Read " & NumberString, 64, "Read")

NoFile: 'in case an error occured go here..

If Err <> 0 Then

Msgbox("Can not read " & CountFileName, 64, "Error")

NumberString = "00000001"

End If

On Local Error Goto 0

Else

Msgbox(CountFileName & " does NOT exists", 64, "Warning")

NumberString = "00000001"

End If

ON ERROR GOTO BadNumber

LongNumber = Int(NumberString) 'a single digit number is returned

LongNumber = LongNumber + 1

BadNumber:

If Err <> 0 Then

Msgbox(NumberString & " is not a number", 64, "Error")

LongNumber = 1

End If

On Local Error Goto 0

NumberString=Trim(Str(LongNumber))

While LEN(NumberString) < 8

NumberString="0"&NumberString

Wend

MsgBox("Number is (" & NumberString & ")", 64, "Information")

iNum = FreeFile

OPEN CountFileName for output as #iNum

PRINT #iNum,NumberString

CLOSE #iNum

End Sub

Create Number Format Style

If you want a particular number format, then you can see if you have it and create it if you do not. For more information on valid formats, see the help contents on topic “number formats; formats”. They can be very complex.

Listing 5.35: Create a number format style.

'******************************************************************

'Author: Andrew Pitonyak

'email: andrew@pitonyak.org

Function FindCreateNumberFormatStyle (_

sFormat As String, Optional doc, Optional locale)

Dim oDocument As Object

Dim aLocale As New com.sun.star.lang.Locale

Dim oFormats As Object

oDocument = IIf(IsMissing(doc), ThisComponent, doc)

oFormats = oDocument.getNumberFormats()

'If you choose to query on types, you need to use the type

'com.sun.star.util.NumberFormat.DATE

'I could set the locale from values stored at

'http://www.ics.uci.edu/pub/ietf/http/related/iso639.txt

'http://www.chemie.fu-berlin.de/diverse/doc/ISO_3166.html

'I use a NULL locale and let it use what ever it likes.

'First, see if the number format exists

If ( Not IsMissing(locale)) Then

aLocale = locale

End If

formatNum = oFormats.queryKey (sFormat, aLocale, TRUE)

MsgBox "Current Format number is" & formatNum

'If the number format does not exist then add it

If (formatNum = -1) Then

formatNum = oFormats.addNew(sFormat, aLocale)

If (formatNum = -1) Then formatNum = 0

MsgBox "new Format number is " & formatNum

End If

FindCreateNumberFormatStyle = formatNum

End Function

View Supported Number Format Styles

The following macro enumerates the current number format styles. The style numbers (keys) and their text representation are inserted into the current document. The disadvantage to this version is that it enumerates the styles based on the locale. The original version enumerated the key from 0 to 1000, ignoring errors. This will find all formats regardless of locale, but I consider this macro a slightly cleaner solution.

Listing 5.36: View the supported number format styles.

Sub enumFormats()

'Author : Laurent Godard

'e-mail : listes.godard@laposte.net

'Modified : Andrew Pitonyak

Dim oText

Dim vFormats, vFormat

Dim vTextCursor, vViewCursor

Dim iMax As Integer, i As Integer

Dim s$

Dim PrevChaine$, Chaine$

Dim aLocale As New com.sun.star.lang.Locale

vFormats = ThisComponent.getNumberFormats()

RunSimpleObjectBrowser(vFormats)

oText = ThisComponent.Text

vViewCursor = ThisComponent.CurrentController.getViewCursor()

vTextCursor = oText.createTextCursorByRange(vViewCursor.getStart())

Dim v

v = vFormats.queryKeys(com.sun.star.util.NumberFormat.ALL, aLocale, False)

For i = LBound(v) To UBound(v)

vFormat=vFormats.getbykey(v(i))

chaine=VFormat.FormatString

If Chaine<>Prevchaine Then

PrevChaine=Chaine

chaine=CStr(v(i)) & CHR$(9) & CHR$(9) & chaine & CHR$(10)

oText.insertString(vTextCursor, Chaine, FALSE)

End If

Next

MsgBox "Finished"

End Sub

Return the Fibonacci array

Listing 5.37: Return an array of Fibonacci numbers.

'******************************************************************

' http://disemia.com/software/openoffice/macro_arrays.html

' Return the sequence of Fibonacci numbers

' assume that count >=2 is to make this code simpler

Function Fibonacci( nCount As Integer )

If nCount < 2 Then nCount = 2

Dim result( 1 to nCount) As Double

Dim i As Integer

result( 1) = 0

result( 2) = 1

For i = 3 to nCount

result(i) = result( i - 2) + result( i - 1)

Next i

Fibonacci = result()

End Function

No matter how I choose to spell Fibonacci, I am told that I have made an incorrect choice. In response, I opted to research the subject, and this is what I found. Fibonacci, as he is usually called, is really Leonardo of Pisa, one of the greatest European mathematician from the middle ages. Leonardo referred to himself as Fibonacci – short for the Latin phrase “filius Bonacci”, which means “the son of Bonaccio”. Fibonacci used the variations “Bonacci”, “Bonaccii” and “Bonacij”; the last usage is from the Latin. The different uses by Leonardo account for the different spellings in common usage today. In English, most modern authors use Fibonacci, but all bets are off if you switch to another language or use an older text.

Insert Text At Bookmark

Listing 5.38: Insert text at a bookmark.

oBookMark = oDoc.getBookmarks().getByName("<yourBookmarkName>")

oBookMark.getAnchor.setString("What you want to insert")

Saving And Exporting A Document

Saving a document is very simple. The following macro will save a document, but it will only save the document if it has been modified, it is not read-only, and it has a location already set to save the document.

Listing 5.39: Save a document if it has not changed and it can be stored.

If (oDoc.isModified) Then

If (oDoc.hasLocation AND (Not oDoc.isReadOnly)) Then

oDoc.store()

End If

End If

If the document is to be saved to a different location, then you must set some properties to direct where and how the document is to be stored.

Listing 5.40: Save a document to a different location.

Dim mFileProperties(0) As New com.sun.star.beans.PropertyValue

Dim sUrl As String

sUrl = "file:///<complete/path/To/New/document>"

REM Set this to True if you want to overwrite the document.

mFileProperties(0).Name = "Overwrite"

mFileProperties(0).Value = False

oDoc.storeAsURL(sUrl, mFileProperties())

The code shown so far, will not export the document to a different type. To do this, a particular export filter must be defined and any required properties must be set. You should know the name of the export filter and the file extension. There is a list of import and export filters at http://framework.openoffice.org/files/documents/25/897/filter_description.html and there is a lot of good information at http://oooconv.free.fr/engine/OOOconv.php as well. A separate method is required for the graphics filters and the rest. To export using a non-graphics format, use a form similar to the following code snippet.

Listing 5.41: Export a document.

Dim args2(1) As New com.sun.star.beans.PropertyValue

args2(0).Name = "InteractionHandler"

args2(0).Value = ""

args2(1).Name = "FilterName"

args2(1).Value = "MS Excel 97" REM Change the export filter

oDoc.storeToURL("file:///c|/new_file.xls",args2()) REM Use the correct file extension

Notice that I used the correct file extension and I specified the specific import filter. Graphics documents are a little different. First, you instantiate a GraphicExportFilter and then you tell it to export one page at a time.

Listing 5.42: Export a document using a GraphicExportFilter.

oFilter=CreateUnoService("com.sun.star.drawing.GraphicExportFilter")

Dim args3(1) As New com.sun.star.beans.PropertyValue

For i=0 to oDoc.drawpages.getcount()-1

oPage=oDoc.drawPages(i)

oFilter.setSourceDocument(opage)

args3(0).Name = "URL"

nom=opage.name

args3(0).Value = "file:///c|/"&oPage.name&".JPG"

args3(1).Name = "MediaType"

args3(1).Value = "image/jpeg"

oFilter.filter(args3())

Next

Tip	The online link to the import/export filters frequently changes, but you can probably find it at the http://framework.openoffice.org site. This is also available in the XML file located in the file: <oooinstallationdir>\share\registry\data\org\openoffice\Office\TypeDetection.xcu

User Fields

I finally spent some time with user fields so although I do not really understand everything that there is to know, I can at least use them. Most people will choose to use the Master Fields. These fields allow you to set your own names and values.

Document Information

There are four fields with the names “Info 1”, “Info 2”, “Info 3”, and “Info 4”. I have essentially no use for them, but they exist and you can access them, so I mention them. You can give them your own name and your own values.

Listing 5.43: Display document information.

' Access the user fields for the information regarding the document.

vInfo = vDoc.getDocumentInfo()

vVal = oData.ElementNames

s = "===User Fields==="

For i = 0 to vInfo.GetUserFieldCount() - 1

sKey = vInfo.GetUserFieldName(i)

sVal = vInfo.GetUserFieldValue(i)

s = s & Chr$(13) & "(" & sKey & "," & sVal & ")"

Next i

'(Info 1,)

'(Info 2,)

'(Info 3,)

'(Info 4,)

MsgBox s, 0, "User Fields"

The general document information such as author, creation date is also avaiable from the document information object. In my macro book, I discuss how to access the properties direction using properties (see page 208 and 209).

Listing 5.44: Display more document information.

Sub InspectDocumentProperties

REM Author: Andrew Pitonyak

REM Certain types of properties can not be directly converted to

REM a string so I use On Error Resume Next. As of July 27, 2005,

REM in OOo 2.0 beta, all properties that fail are date structures

REM so this is not really needed right now.

On Error Resume Next

Dim oPropValues() ' Array of property values

Dim i% ' General index variable

Dim s$ ' General string variable

REM Get the property values from the document information object.

REM This is an array of property values.

oPropValues() = ThisComponent.getDocumentInfo().getPropertyValues()

For i=LBound(oPropValues()) To UBound(oPropValues())

s = s & oPropValues(i).Name

REM The property value is a struct so it is probably a Date

REM structure.

If IsUnoStruct(oPropValues(i).Value) Then

REM If the name contains "Date", then assume that it is

REM a date object.

If InStr(oPropValues(i).Name, "Date") > 0 Then

With oPropValues(i).Value

s = s & " : " & .Month & "/" & .Day & "/" & .Year & _

" " & .Hours & ":" & .Minutes & ":" & .Seconds & _

"." & .HundredthSeconds

End With

Else

REM This is an unknown property value.

s = s & "?:?"

End If

Else

REM The property is not a struct. This line will

REM fail if the object is not automatically converted

REM to a string.

s = s & ":" & oPropValues(i).Value

End If

s = s & CHR$(10)

Next

MsgBox s

End Sub

Text Fields

The following macro, provide by Heike Talhammer, demonstrates how to enumerate the text fields contained in a document. The macro sets the field values and then uses refresh to cause the fields to update. In case you missed it, I will say it again: This macro changes the value of all of the fields contained in your document.

Listing 5.45: Enumerate text fields.

REM Author: Heike Talhammer <info@bios-pro.de>

REM Modified: Andrew Pitonyak

Sub EnumerateFields

Dim vEnum

Dim vVal

Dim s1$, s2$

Dim sFieldName$, sFieldValue$, sInstanceName$, sHint$, sContent$

vEnum = thisComponent.getTextFields().createEnumeration()

If Not IsNull(vEnum) Then

Do While vEnum.hasMoreElements()

vVal = vEnum.nextElement()

If vVal.supportsService("com.sun.star.text.TextField.Input") Then

sHint=vVal.getPropertyValue("Hint")

sContent=vVal.getPropertyValue("Content")

s1=s1 &"Hint:" & sHint & " - Content: " & sContent & chr(13)

'change the content

vVal.setPropertyValue("Content", "My new content")

ThisComponent.TextFields.refresh()

End If

If vVal.supportsService("com.sun.star.text.TextField.User") Then

sFieldName =vVal.textFieldMaster.Name

sFieldValue = vVal.TextFieldMaster.Value

sInstanceName= vVal.TextFieldMaster.InstanceName

s2 = s2 & sFieldName & " = " & sFieldValue & chr(13) & "InstanceName: " & _

sInstanceName & chr(13)

'new value for textfield

vVal.TextFieldMaster.Value=25

End If

Loop

MsgBox s1, 0, "=== Input Fields ==="

MsgBox s2, 0, "=== User Fields ==="

End If

ThisComponent.TextFields.refresh()

End Sub

Master Fields

Master fields are nice, you can set your own values, formulas, or numeric values. This is only a brief investigation but it should be enough to get you started. I have found five types of master fields: Illustration, Table, Text, Drawing, and User. The names of these fields all begin with “com.sun.star.text.FieldMaster.SetExpression.” followed by the type and then finally followed by another period and the name. Here is a simple way to create or modify a text field.

Listing 5.46: Get a master field.

vDoc = ThisComponent

sName = "Author Name"

If vDoc.getTextFieldMasters().hasByName("com.sun.star.text.FieldMaster.User." & sName) Then

vField = vDoc.getTextFieldMasters().getByName("com.sun.star.text.FieldMaster.User." & sName)

vField.Content = "Andrew Pitonyak"

'vField.Value = 2.3 REM If you would rather this were a number!

Else

vField = vDoc.createInstance("com.sun.star.text.FieldMaster.User")

vField.Name = sName

vField.Content = "Andrew Pitonyak"

'vField.Value = 2.3 REM If you would rather this were a number!

End If

This macro will display all of the master fields in the document.

Listing 5.47: Display all master fields.

Sub FieldExamples

Dim vDoc, vInfo, vVal, vNames

Dim i%, sKey$, sVal$, s$

vDoc = ThisComponent

Dim vTextFieldMaster

Dim sUserType$

sUserType = "com.sun.star.text.FieldMaster.User"

vVal = vDoc.getTextFieldMasters()

vNames = vVal.getElementNames()

'You will have names such as:

'com.sun.star.text.FieldMaster.SetExpression.Illustration

'com.sun.star.text.FieldMaster.SetExpression.Table

'com.sun.star.text.FieldMaster.SetExpression.Text

'com.sun.star.text.FieldMaster.SetExpression.Drawing

'com.sun.star.text.FieldMaster.User

s = "===Text Field Masters==="

For i = LBound(vNames) to UBound(vNames)

sKey = vNames(i)

s = s & Chr$(13) & "(" & sKey

vTextFieldMaster = vVal.getByName(sKey)

If Not IsNull(vTextFieldMaster) Then

s = s & "," & vTextFieldMaster.Name

'I have not verified that this is the case!

If (Left$(sKey,Len(sUserType)) = sUserType) Then

'User types also have a Value (double) and you can ask if they are

'expressions!

'http://api.openoffice.org/docs/common/ref/com/sun/star/text/FieldMaster/User.html

s = s & "," & vTextFieldMaster.Content

End If

End If

s = s & ")"

Next i

MsgBox s, 0, "Text Field Masters"

End Sub

The following routines, posted by Rodrigo V Nunes [rodrigo.nunes@net-linx.com], show that setting Document variables (like for MS Word documents) are possible in OOo.

Listing 5.48: Setting document variables.

'===========================================================================

' CountDocVars - routine used to count the number of document variables available for the

' current document

' In - DocVars: array of current document variables (name) present in the ad

' DocVarValue: array of current document variables (value) present in the ad

' Out - integer with the total number of doc variables found

'===========================================================================

Function CountDocVars(DocVars , DocVarValue) As Integer

Dim VarCount As Integer

Dim Names as Variant

VarCount = 0

Names = thisComponent.getTextFieldMasters().getElementNames()

For i%=LBound(Names) To UBound(Names)

if (Left$(Names(i%),34) = "com.sun.star.text.FieldMaster.User") Then

xMaster = ThisComponent.getTextFieldMasters.getByName(Names(i%))

DocVars(VarCount) = xMaster.Name

DocVarValue(VarCount) = xMaster.Value

VarCount = VarCount + 1 ' it's a document variable created by the user

End if

Next i%

CountDocVars = VarCount

End Function

'

'===========================================================================

' SetDocumentVariable - routine used to create/set value of a document variable into

' the document user's textfield list, without physically inserting its contents in

' the text of the ad.

' In - strVarName: string with the name of the variable to be set/created

' aValue: string with the value of the doc variable

' Out - boolean flag with the operation status: TRUE=OK, FALSE=variable could not be

' set/created

'===========================================================================

Function SetDocumentVariable(ByVal strVarName As String, ByVal aValue As String ) As Boolean

Dim bFound As Boolean

On Error GoTo ErrorHandler

oActiveDocument = thisComponent

oTextmaster = oActiveDocument.getTextFieldMasters()

sName = "com.sun.star.text.FieldMaster.User." + strVarName

bFound = oActiveDocument.getTextFieldMasters.hasbyname(sName) ' check if variable exists

if bFound Then

xMaster = oActiveDocument.getTextFieldMasters.getByName( sName )

REM value MEMBER used for decimal values, CONTENT member for Strings

'xMaster.value = aValue

xMaster.Content = aValue

Else ' Document variable doesn't exist yet

sService = "com.sun.star.text.FieldMaster.User"

xMaster = oActiveDocument.createInstance( sService )

xMaster.Name = strVarName

xMaster.Content = aValue

End If

SetDocumentVariable = True 'Success

Exit Function

ErrorHandler:

SetDocumentVariable = False

End Function

'

'

'===========================================================================

' InsertDocumentVariable - routine used to insert a document variable into the document

' user's textfield list and into the ad text, at the current cursor

' position

' In - strVarName: string with the name of the variable to be inserted

' oTxtCursor: current cursor object with the position to place the doc var

' Out - none

'===========================================================================

Sub InsertDocumentVariable(strVarName As String, oTxtCursor As Object)

oActiveDocument = thisComponent

objField = thisComponent.createInstance("com.sun.star.text.TextField.User")

sName = "com.sun.star.text.FieldMaster.User." + strVarName

bFound = oActiveDocument.getTextFieldMasters.hasbyname(sName) ' check if variable exists

if bFound Then

objFieldMaster = oActiveDocument.getTextFieldMasters.getByName(sName)

objField.attachTextFieldMaster(objFieldMaster)

' Insert the Text Field

oText = thisComponent.Text

'oCursor = oText.createTextCursor()

'oCursor.gotoEnd(false)

oText.insertTextContent(oTxtCursor, objField, false)

End If

End Sub

'

'

'

'

'===========================================================================

' DeleteDocumentVariable - routine used to eliminate a document variable from the document

' user's textfield list

' In - strVarName: string with the name of the variable to be deleted

' Out - none

'===========================================================================

Sub DeleteDocumentVariable(strVarName As String)

oActiveDocument = thisComponent

objField = oActiveDocument.createInstance("com.sun.star.text.TextField.User")

sName = "com.sun.star.text.FieldMaster.User." + strVarName

bFound = oActiveDocument.getTextFieldMasters.hasbyname(sName) ' check if variable exists

if bFound Then

objFieldMaster = oActiveDocument.getTextFieldMasters.getByName(sName)

objFieldMaster.Content = ""

objFieldMaster.dispose()

End If

End Sub

'

'===========================================================================

' SetUserVariable - function used to set/create user variables inside of the document. These

' variables are for internal system use/control only, and will NOT be

' available or used in the java application (see 'SetDocumentVariables' for

' document shared variable creation/set)

'

' In - strVarName: string with the name of the variable to be set. If the variable does not

' exist, it'll be created

' avalue: Variant value with the new content of the variable defined in strVarName

' Out - boolean flag with the operation status: TRUE=OK, FALSE=variable

' could not be set/created

'===========================================================================

Function SetUserVariable(ByVal strVarName As String, ByVal avalue As Variant) As Boolean

Dim aVar As Variant

Dim index As Integer 'Index of the existing variable name

Dim vCount As Integer

On Error GoTo ErrorHandler

'Look to see if the document variable already exists.

oDocumentInfo = thisComponent.Document.Info

vCount = oDocumentInfo.getUserFieldCount()

bFound = false

For i% = 0 to (vCount - 1)

If strVarName = oDocumentInfo.getUserFieldName(i%) Then

bFound = true

oDocumentInfo.setUserFieldValue(i%,avalue)

End If

Next i%

If not bFound Then 'Document variable doesn't exist yet

oDocumentInfo.setUserFieldName(i,strVarName)

oDocumentInfo.setUserValue(i,avalue)

End If

' test if value is bigger than the number of user variables !

SetUserVariable = True 'Success

Exit Function

ErrorHandler:

SetUserVariable = False

End Function

Christian Junker wrote the following macro to call and test the routines above:

Listing 5.49: Use the code in Listing 5.48

REM Here is my code to call the routines above:

Sub Using_docVariables()

odoc = thisComponent

otext = odoc.getText()

ocursor = otext.createTextCursor()

ocursor.goToStart(false)

SetDocumentVariable("docVar1", "Value 1") 'create my DocVariable

InsertDocumentVariable("docVar1", ocursor) 'insert it into the current document

End Sub

Removing Text Fields

Retrieve the text field and then dispose it using field.dispose()!

Insert a URL into a Calc cell

For reasons that defy me, the following functionality has been requested numerous times. I opted to add this example because I am tired of figuring out how to do it every time. The InsertURLIntoCell macro converts the text of a cell into a URL and then inserts a URL text field into the cell. Read the comments to see how this is done.

Listing 5.50: Insert a URL into a Calc cell.

Sub InsertURLIntoCell

Dim oText 'Text object for the current object

Dim oField 'Field to insert

Dim oCell 'Get a specific cell

Rem Get a cell, any cell. This obtains cell C3

oCell = ThisComponent.Sheets(0).GetCellByPosition(2,2)

REM Create a URL Text field

oField = ThisComponent.createInstance("com.sun.star.text.TextField.URL")

REM This is the actual text that is displayed for the URL

REM This could just as easily be

REM oField.Representation = "My Secret Text"

oField.Representation = oCell.getString()

REM The URL property is just a text string of the URL itself.

oField.URL = ConvertToURL(oCell.getString())

REM The text field is added as text content into the cell.

REM If you do not now set the string to zero, then the existing

REM text will remain and the new URL text field will be appended

REM to the end.

oCell.setString("")

oText = oCell.getText()

oText.insertTextContent(oText.createTextCursor(), oField, False)

End Sub

Warning	This does not work in a Write document, so do not try it!

Adding a SetExpression TextField

I create an use my own SetExpression fields to number my text tables, code listings, figured, and anything else that must be sequentially numbered. The following code assumes that you know how to add these manually and that there already exists a number field named Table. Use Insert | Fields | Other to open the Fields dialog. Select the Variables tab. In the type box, choose “Number Range”. Normally, I would enter the expression “Table+1”, but I want to add one using a macro.

Listing 5.51: Append a SetExpression text field to the end of the document.

Sub AddExpressionField

Dim oField ' This is the SestExpression field that is inserted.

Dim oMasterField ' The master field for the SetExpression field.

Dim sMasterFieldName$ ' This is the name of the master field.

Dim oDoc ' The document that will contain the field.

Dim oText ' The documents text object.

oDoc = ThisComponent

REM The text field must be created by the document that will contain it.

oField = oDoc.createInstance("com.sun.star.text.TextField.SetExpression")

REM Set the expression

oField.Content = "Table+1"

REM Normally, you might want to create or check the number format.

REM I am cheating because I happen to know what it is and I want a shorter

REM example. I have examples elsewhere that show you how to get the index

REM of a number format.

oField.NumberFormat = 4

oField.NumberingType = 4

REM Wow, now that is a long name. All master fields are named this way.

REM Use the name to get the master field that is assumed to exist.

sMasterFieldName = "com.sun.star.text.FieldMaster.SetExpression.Table"

oMasterField = oDoc.getTextFieldMasters().getByName(sMasterFieldName)

REM Attach the text field to its master.

oField.attachTextFieldMaster(oMasterField)

REM Finally, insert the field at the END of the document.

oText = oDoc.getText()

oText.insertTextContent(oText.getEnd(), oField, False)

End Sub

User Defined Data Types

As of OOo 1.1.1, you can define your own data types.

Listing 5.52: You can define your own data types.

Type PersonType

FirstName As String

LastName As String

End Type

Sub ExampleCreateNewType

Dim Person As PersonType

Person.FirstName = "Andrew"

Person.LastName = "Pitonyak"

PrintPerson(Person)

End Sub

Sub PrintPerson(x)

Print "Person = " & x.FirstName & " " & x.LastName

End Sub

I gave a presentation at the 2004 OOo Conference in Berlin concerning creating advanced data types using structures. The examples are in the presentation available on my web site.

Spell Check, Hyphenation, and Thesaurus

Performing a spell check, hyphenation, and a thesaurus lookup is very easy. These parts will return null values if their corresponding parts are not configured. In my initial testing, the Hyphenation routine always returned null until I configured the Hyphenation from the Options dialog.

Listing 5.53: Spell, hyphenate, and use a thesaurus.

Sub SpellCheckExample

Dim s() As Variant

Dim vReturn As Variant, i As Integer

Dim emptyArgs(0) As New com.sun.star.beans.PropertyValue

Dim aLocale As New com.sun.star.lang.Locale

aLocale.Language = "en"

aLocale.Country = "US"

s = Array("hello", "anesthesiologist", "PNEUMONOULTRAMICROSCOPICSILICOVOLCANOCONIOSIS", "Pitonyak", "misspell")

'*********Spell Check Example!

'http://api.openoffice.org/docs/common/ref/com/sun/star/linguistic2/XSpellChecker.html

Dim vSpeller As Variant

vSpeller = createUnoService("com.sun.star.linguistic2.SpellChecker")

'Use vReturn = vSpeller.spell(s, aLocale, emptyArgs()) if you want options!

For i = LBound(s()) To UBound(s())

vReturn = vSpeller.isValid(s(i), aLocale, emptyArgs())

MsgBox "Spell check on " & s(i) & " returns " & vReturn

Next

'******Hyphenation Example!

'http://api.openoffice.org/docs/common/ref/com/sun/star/linguistic2/XHyphenator.html

Dim vHyphen As Variant

vHyphen = createUnoService("com.sun.star.linguistic2.Hyphenator")

For i = LBound(s()) To UBound(s())

'vReturn = vHyphen.hyphenate(s(i), aLocale, 0, emptyArgs())

vReturn = vHyphen.createPossibleHyphens(s(i), aLocale, emptyArgs())

If IsNull(vReturn) Then

'hyphenation is probablly off in the configuration

MsgBox "Hyphenating " & s(i) & " returns null"

Else

MsgBox "Hyphenating " & s(i) & " returns " & vReturn.getPossibleHyphens()

End If

Next

'******Thesaurus Example!

'http://api.openoffice.org/docs/common/ref/com/sun/star/linguistic2/XThesaurus.html

Dim vThesaurus As Variant, j As Integer, k As Integer

vThesaurus = createUnoService("com.sun.star.linguistic2.Thesaurus")

s = Array("hello", "stamp", "cool")

For i = LBound(s()) To UBound(s())

vReturn = vThesaurus.queryMeanings(s(i), aLocale, emptyArgs())

If UBound(vReturn) < 0 Then

Print "Thesaurus found nothing for " & s(i)

Else

Dim sTemp As String

sTemp = "Hyphenated " & s(i)

For j = LBound(vReturn) To UBound(vReturn)

sTemp = sTemp & Chr(13) & "Meaning = " & vReturn(j).getMeaning() & Chr(13)

Dim vSyns As Variant

vSyns = vReturn(j).querySynonyms()

For k = LBound(vSyns) To UBound(vSyns)

sTemp = sTemp & vSyns(k) & " "

Next

sTemp = sTemp & Chr(13)

Next

MsgBox sTemp

End If

Next

End Sub

Changing The Mouse Cursor

The quick answer is: This is not supported.

A desire to change the mouse cursor sparked an interesting discussion that I took the time to follow but I did not test. I have edited the messages for brevity.

anindya@agere.com asked: I want the mouse pointer to be an hour glass while a macro is running. What is wrong with this code?

Listing 5.54: You can not change the mouse cursor as of OOo version 1.1.3.

oDocument = oDeskTop.loadComponentFromURL(fileName,"_blank",0,mArg())

oCurrentController = oDocument.getCurrentController()

oFrame = oCurrentController.getFrame()

oWindow = oFrame.getContainerWindow()

oPointer = createUnoService("com.sun.star.awt.Pointer")

oPointer.SetType(com.sun.star.awt.SystemPointer.WAIT)

oWindow.setPointer(oPointer)

Mathias Bauer, whom we all love, responded. You can not set the mouse pointer of a document window via UNO-API. VCL manages the mouse pointer based on the window, not the top window. Any VCL window can have its own mouse pointer set. If you want to change the mouse pointer of the document window, you must access its XWindowPeer (not the peer of the frame window), and this is not available in the API. Another problem might be that OOo changes the mouse pointer internally and overrides your setting.

Berend Cornelius provided the final response. Your Sub works fine with any sub-window in your document. The following code refers to a control in a document:

Listing 5.55: Switch the mouse pointer for a control.

Sub Main

GlobalScope.BasicLibraries.LoadLibrary("Tools")

oController = Thiscomponent.getCurrentController()

oControl =oController.getControl(ThisComponent.Drawpage().getbyIndex(0).getControl())

SwitchMousePointer(oControl.getPeer(), False)

End Sub

This routine changes the mouse pointer when it is over the control, but when the pointer is not over the control window it changes back. You want a "Wait" function that places the pointer in a wait state but this is currently not supported by the API.

It is my opinion that you can change it but not for all things.

oDoc.getCurrentController().getFrame().getContainerWindow().setPointer(...)

Setting The Page Background

Listing 5.56: Set a page background.

Sub Main

' First get the Style Families

oStyleFamilies= ThisComponent.getStyleFamilies()

' then get the PageStyles

oPageStyles= oStyleFamilies.getByName("PageStyles")

' then get YOUR page's style

oMyPageStyle= oPageStyles.getByName("Standard")

' then set your background

with oMyPageStyle

.BackGraphicUrl= _

convertToUrl( <pathToYourGraphic> )

.BackGraphicLocation= _

com.sun.star.style.GraphicLocation.AREA

end with

End Sub

Manipulating The Clipboard

See the Developer's Guide page 377 (note that the page number changes as the Developer's Guide changes).

I do not know the best methods of accessing the clipboard, but what is presented here has worked for someone, somewhere, sometime.

To copy data to the clipboard, you must first select data. The optional Controller interface com.sun.star.view.XSelectionSupplier provides the ability to select objects and to access the currently selected objects. This document contains special sections on obtaining the selected text with both Calc and Write documents.

Copy Spreadsheet Cells With The Clipboard

The first example sent to me selects cells in a spreadsheet and then pastes them into a different spreadsheet.

Listing 5.57: Copy and paste a range using the clipboard.

'Author: Ryan Nelson

'email: ryan@aurelius-mfg.com

'Modified By: Christian Junker

'This macro copies a range and pastes it into a new or existing spreadsheet.

Sub CopyPasteRange()

Dim oSourceDoc As Object, oSourceSheet As Object, oSourceRange As Object

Dim oTargetDoc As Object, oTargetSheet As Object, oTargetCell As Object

Dim oDispatcher, octl as Object,

Dim sUrl As String

Dim NoArg()

REM Set source doc/currentController/frame/sheet/range.

oSourceDoc=ThisComponent

octl = oSourcedoc.getCurrentController()

oSourceframe = octl.getFrame()

oSourceSheet= oSourceDoc.Sheets(0)

oSourceRange = oSourceSheet.getCellRangeByPosition(0,0,100,10000)

REM create the DispatcherService

oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

REM select source range

octl.Select(oSourceRange)

REM copy the current selection to the clipboard.

oDispatcher.executeDispatch(octl, ".uno:Copy", "", 0, NoArg())

REM open new spreadsheet.

oTargetDoc = Stardesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, NoArg())

oTargetSheet = oTargetDoc.getSheets.getByIndex(0)

REM You may want to clear the target range prior to pasting to it if it

REM contains data and formatting.

REM Move focus to cell 0,0. This ensures the focus is on the "0,0" cell prior to pasting.

REM You could set this to any cell. If you don't set the position, it will paste to the

REM position that was last in focus when the sheet was last open.

oTargetCell = oTargetSheet.getCellByPosition(0,0)

oTargetDoc.getCurrentController().Select(oTargetCell)

REM paste from the clipboard to your current location.

oTargetframe = oTargetDoc.getCurrentController().getFrame()

oDispatcher.executeDispatch(oTargetFrame, ".uno:Paste", "", 0, NoArg())

End Sub

Copy Spreadsheet Cells Without The Clipboard

You can copy, insert, move, and remove cells within the same Calc document without using the clipboard – even between different sheets. See:
http://api.openoffice.org/docs/common/ref/com/sun/star/sheet/XCellRangeMovement.html
for more details. The following code was posted on the devapi mailing list.

Listing 5.58: Copy and paste a range without the clipboard.

' Author: Oliver Brinzing

' email: OliverBrinzing@t-online.de

Sub CopySpreadsheetRange

oSheet1 = ThisComponent.Sheets.getByIndex(0) ' sheet no 1, original

oSheet2 = ThisComponent.Sheets.getByIndex(1) ' sheet no 2

oRangeOrg = oSheet1.getCellRangeByName("A1:C10").RangeAddress ' copy range

oRangeCpy = oSheet2.getCellRangeByName("A1:C10").RangeAddress ' insert range

oCellCpy = oSheet2.getCellByPosition(oRangeCpy.StartColumn,_

oRangeCpy.StartRow).CellAddress ' insert position

oSheet1.CopyRange(oCellCpy, oRangeOrg) ' copy

End Sub

Getting the content-type of the Clipboard

I created the following clip to demonstrate how to access the clipboard directly. In general, this is not practical for anything other than direct text manipulations.

Listing 5.59: Manipulate the clipboard.

Sub ConvertClipToText

REM Author: Andrew Pitonyak

Dim oClip, oClipContents, oTypes

Dim oConverter, convertedString$

Dim i%, iPlainLoc%

iPlainLoc = -1

oClip = createUnoService("com.sun.star.datatransfer.clipboard.SystemClipboard")

oConverter = createUnoService("com.sun.star.script.Converter")

'Print "Clipboard name = " & oClip.getName()

'Print "Implemantation name = " & oClip.getImplementationName()

oClipContents = oClip.getContents()

oTypes = oClipContents.getTransferDataFlavors()

Dim msg$, iLoc%, outS

msg = ""

iLoc = -1

For i=LBound(oTypes) To UBound(oTypes)

If oTypes(i).MimeType = "text/plain;charset=utf-16" Then

iPlainLoc = i

Exit For

End If

'msg = msg & "Mime type = " & x(ii).MimeType

'msg = msg & " normal = " & x(ii).HumanPresentableName & Chr$(10)

Next

If (iPlainLoc >= 0) Then

Dim oData

oData = oClipContents.getTransferData(oTypes(iPlainLoc))

convertedString = oConverter.convertToSimpleType(oData, com.sun.star.uno.TypeClass.STRING)

MsgBox convertedString

End If

End Sub

Setting The Locale (Language)

In OOo, characters contain a locale, which identifies the language and country. I use styles to format my macro code samples. I set the locale in the macro code styles to unknown so that their spelling is not checked – if the locale is not known, then OOo does not know which dictionary to use. To tell OOo that a word is French, you set the locale of the characters to French. I was asked how to set the locale for all of the text in a document to a single value. This seemed obvious at first. A cursor supports character properties which allows you to set the locale. I created a cursor, selected the entire document, and then set the locale. I received a runtime error. I found out that the locale property is optional – it may be empty, as in IsEmpty(oCurs.CharLocale) is true. Although my next try worked for my document, you should perform more testing with tables and other things. It is safer to use an enumeration, because an enumeration can enumerate sections that all use the same property values so you can then always set the locale.

Listing 5.60: Set the document locale.

Sub SetDocumentLocale

Dim oCursor

Dim aLocale As New com.sun.star.lang.Locale

aLocale.Language = "fr"

aLocale.Country = "FR"

REM This assumes a text document

REM Get the Text component from the document

REM Create a Text cursor

oCursor = ThisComponent.Text.createTextCursor()

REM Goto the start of the document

REM Then, goto the end of the document selecting ALL the text

oCursor.GoToStart(False)

Do While oCursor.gotoNextParagraph(True)

oCursor.CharLocale = aLocale

oCursor.goRight(0, False)

Loop

Msgbox "successfully francophonized"

End Sub

It may be prudent to to add the line “On Local Error Resume Next”, but I did not try it and it would hide any errors during your initial testing.

You should be able to set the locale for selected text or text that was found using the built in search routines as well.

Setting the locale for selected text

To demonstrate a slightly different method, I the following macro sets the locale for selected text, or for the entire document. I removed most of the comments. See the section dealing with selected text in a text document. The macro in Listing 5.60 iterates through the document using a paragraph cursor. I opted to not use a paragraph cursor in Listing 5.61, because the selected text may not include an entire paragraph. The primary concern with this method, is that a very large document may take a lot of time to iterate through one character at a time.

Listing 5.61: Set the locale for selected text (or the document).

Sub MainSetLocale

Dim oLoc As New com.sun.star.lang.Locale

'oLoc.Language = "fr" : oLoc.Country = "FR"

oLoc.Language = "en" : oLoc.Country = "US"

SetLocaleForDoc(ThisComponent, oLoc)

End sub

Sub SetLocaleForDoc(oDoc, oLoc)

Dim oCursors()

Dim sPrompt$

Dim i%

sPrompt = "Set locale to (" & oLoc.Language & ", " & oLoc.Country & ")?"

If NOT CreateSelTextIterator(oDoc, sPrompt, oCursors()) Then Exit Sub

For i = LBound(oCursors()) To UBound(oCursors())

SetLocaleForCurs(oCursors(i, 0), oCursors(i, 1), oLoc)

Next

End Sub

Sub SetLocaleForCurs(oLCurs, oRCurs, oLoc)

Dim oText

If IsNull(oLCurs) OR IsNull(oRCurs) Then Exit Sub

If IsEmpty(oLCurs) OR IsEmpty(oRCurs) Then Exit Sub

oText = oLCurs.getText()

If oText.compareRegionEnds(oLCurs, oRCurs) <= 0 Then Exit Sub

oLCurs.goRight(0, False)

Do While oLCurs.goRight(1, True) AND oText.compareRegionEnds(oLCurs, oRCurs) >= 0

oLCurs.CharLocale = oLoc

oLCurs.goRight(0, False)

Loop

End Sub

Function CreateSelTextIterator(oDoc, sPrompt As String, oCursors()) As Boolean

Dim lSelCount As Long 'Number of selected sections.

Dim lWhichSel As Long 'Current selection item.

Dim oSels 'All of the selections

Dim oLCurs As Object 'Cursor to the left of the current selection.

Dim oRCurs As Object 'Cursor to the right of the current selection.

CreateSelTextIterator = True

If Not IsAnythingSelected(oDoc) Then

Dim i%

i% = MsgBox("No text selected!" + Chr(13) + sPrompt, _

1 OR 32 OR 256, "Warning")

If i% = 1 Then

oLCurs = oDoc.getText().createTextCursor()

oLCurs.gotoStart(False)

oRCurs = oDoc.getText().createTextCursor()

oRCurs.gotoEnd(False)

oCursors = DimArray(0, 1)

oCursors(0, 0) = oLCurs

oCursors(0, 1) = oRCurs

Else

oCursors = DimArray()

CreateSelTextIterator = False

End If

Else

oSels = oDoc.getCurrentSelection()

lSelCount = oSels.getCount()

oCursors = DimArray(lSelCount - 1, 1)

For lWhichSel = 0 To lSelCount - 1

GetLeftRightCursors(oSels.getByIndex(lWhichSel), oLCurs, oRCurs)

oCursors(lWhichSel, 0) = oLCurs

oCursors(lWhichSel, 1) = oRCurs

Next

End If

End Function

Function IsAnythingSelected(oDoc) As Boolean

Dim oSels 'All of the selections

Dim oSel 'A single selection

Dim oCursor 'A temporary cursor

IsAnythingSelected = False

If IsNull(oDoc) Then Exit Function

oSels = oDoc.getCurrentSelection()

If IsNull(oSels) Then Exit Function

If oSels.getCount() = 0 Then Exit Function

REM If there are multiple selections, then certainly something is selected

If oSels.getCount() > 1 Then

IsAnythingSelected = True

Else

oSel = oSels.getByIndex(0)

oCursor = oSel.getText().CreateTextCursorByRange(oSel)

If Not oCursor.IsCollapsed() Then IsAnythingSelected = True

End If

End Function

Sub GetLeftRightCursors(oSel, oLeft, oRight)

Dim oCursor

If oSel.getText().compareRegionStarts(oSel.getEnd(), oSel) >= 0 Then

oLeft = oSel.getText().CreateTextCursorByRange(oSel.getEnd())

oRight = oSel.getText().CreateTextCursorByRange(oSel.getStart())

Else

oLeft = oSel.getText().CreateTextCursorByRange(oSel.getStart())

oRight = oSel.getText().CreateTextCursorByRange(oSel.getEnd())

End If

oLeft.goRight(0, False)

oRight.goLeft(0, False)

End Sub

Auto Text

I have not tested this code, but I have been assured that it works. You will not be able to use the code as written because it requires a dialog that you do not have, but the techniques used will be useful just the same. Some links that I found include:
http://api.openoffice.org/docs/common/ref/com/sun/star/text/XAutoTextGroup.html
http://api.openoffice.org/docs/common/ref/com/sun/star/text/AutoTextGroup.html
http://api.openoffice.org/docs/common/ref/com/sun/star/text/AutoTextContainer.html
http://api.openoffice.org/docs/common/ref/com/sun/star/text/XAutoTextContainer.html

Listing 5.62: Using auto text.

'Author: Marc Messeant

'email: marc.liste@free.fr

'To copy one AutoText From a group to an other one

'ListBox1 : The initial group

'ListBox2 : the Destination Group

'ListBox3 : The Element of the initial group to copy

'ListBox4 : The Element of the Destination group (for information only)

Dim ODialog as object

Dim oAutoText as object

' This subroutine opens the Dialog and initialize the lists of Group

Sub OuvrirAutoText

Dim aTableau() as variant

Dim i as integer

Dim oListGroupDepart as object, oListGroupArrivee as object

oDialog = LoadDialog("CG95","DialogAutoText")

oListGroupDepart = oDialog.getControl("ListBox1")

oListGroupArrivee = oDialog.getControl("ListBox2")

oAutoText = createUnoService("com.sun.star.text.AutoTextContainer")

aTableau = oAutoText.getElementNames()

oListGroupDepart.removeItems(0,oListGroupDepart.getItemCount())

oListGroupArrivee.removeItems(0,oListGroupArrivee.getItemCount())

For i = LBound(aTableau()) To UBound(aTableau())

oListGroupDepart.addItem(aTableau(i),i)

oListGroupArrivee.addItem(aTableau(i),i)

Next

oDialog.Execute()

End Sub

'The 3 routines are called when the user selects one group to

'initialize the lists of AutoText elements for each group

Sub ChargerList1()

ChargerListeGroupe("ListBox1","ListBox3")

End Sub

Sub ChargerList2()

ChargerListeGroupe("ListBox2","ListBox4")

End Sub

Sub ChargerListeGroupe(ListGroupe as string,ListElement as string)

Dim oGroupe as object

Dim oListGroupe as object

Dim oListElement as object

Dim aTableau() as variant

Dim i as integer

oListGroupe = oDialog.getControl(ListGroupe)

oListElement = oDialog.getControl(ListElement)

oGroupe = oAutoText.getByIndex(oListGroupe.getSelectedItemPos())

aTableau = oGroupe.getTitles()

oListElement.removeItems(0,oListElement.getItemCount())

For i = LBound(aTableau()) To UBound(aTableau())

oListElement.addItem(aTableau(i),i)

Next

End Sub

'This routine transfer one element of one group to an other one

Sub TransfererAutoText()

Dim oGroupDepart as object,oGroupArrivee as object

Dim oListGroupDepart as object, oListGroupArrivee as object

Dim oListElement as object

Dim oElement as object

Dim aTableau() as string

Dim i as integer

oListGroupDepart = oDialog.getControl("ListBox1")

oListGroupArrivee = oDialog.getControl("ListBox2")

oListElement = oDialog.getControl("ListBox3")

i =oListGroupArrivee.getSelectedItemPos()

If oListGroupDepart.getSelectedItemPos() = -1 Then

MsgBox ("Vous devez sélectionner un groupe de départ")

Exit Sub

End If

If oListGroupArrivee.getSelectedItemPos() = -1 Then

MsgBox ("Vous devez sélectionner un groupe d'arrivée")

Exit Sub

End If

If oListElement.getSelectedItemPos() = -1 Then

MsgBox ("Vous devez sélectionner un élément à copier")

Exit Sub

End If

oGroupDepart = oAutoText.getByIndex(oListGroupDepart.getSelectedItemPos())

oGroupArrivee = oAutoText.getByIndex(oListGroupArrivee.getSelectedItemPos())

aTableau = oGroupDepart.getElementNames()

oElement = oGroupDepart.getByIndex(oListElement.getSelectedItemPos())

If oGroupArrivee.HasByName(aTableau(oListElement.getSelectedItemPos())) Then

MsgBox ("Cet élément existe déja")

Exit Sub

End If

oGroupArrivee.insertNewByName(aTableau(oListElement.getSelectedItemPos()),_

oListElement.getSelectedItem(),oElement.Text)

ChargerListeGroupe("ListBox2","ListBox4")

End Sub

Decimal Feet To Fraction

I was asked to convert some Microsoft Office Macros to OOo Macros. I decided to improve them. The first set took a decimal number of feet and converted this to feet and inches in fractions. I decided to produce some general routines and ignore the existing code. This also avoided a few bugs that I found in the existing code. The quickest method that I know to reduce a fraction is to find the GCD (Greatest Common Divisor). The fraction macro calls GCD to simplify the fraction.

Listing 5.63: Calcuate the GCD

'Author: Olivier Bietzer

'e-mail: olivier.bietzer@free.fr

'This uses Euclide's algorithm and it is very fast!

Function GCD(ByVal x As Long, ByVal y As Long) As Long

Dim pgcd As Long, test As Long

' We must have x >= y and positive values

x=abs(x)

y=abs(y)

If (x < y) Then

test = x : x = y : y = test

End If

If y = 0 Then Exit Function

' Euclide says ....

pgcd = y ' by definition, PGCD is the smallest

test = x MOD y ' rest of division

Do While (test) ' While not 0

pgcd = test ' pgcd is the rest

x = y ' x,y and current pgcd permutation

y = pgcd

test = x MOD y ' test again

Loop

GCD = pgcd ' pgcd is the last non 0 rest ! Magic ...

End Function

The following macro determines the fraction. If x is negative, then both the numerator and the returned value of x are negative on output. Note that the parameter x is modified.

Listing 5.64: Convert a double to a fraction.

'n: on output, contains the numerator

'd: on output, contains the denominator

'x: Inxput x to turn into a fraction, output the integer portion

'max_d: Maximum denominator

Sub ToFraction(n&, d&, x#, ByVal max_d As Long)

Dim neg_multiply&, y#

n = 0 : d = 1 : neg_multiply = 1 : y = Fix(x)

If (x < 0) Then

x = -x : neg_multiply = -1

End If

REM Just in case x does not contain a fraction

If (n <> 0) Then

d = GCD(n, max_d)

n = neg_multiply * n / d

d = max_d / d

x = y

End If

x = y

End Sub

To test this routine, I created the following test code.

Sub FractionTest

Dim x#, inc#, first#, last#, y#, z#, epsilon#

Dim d&, n&, max_d&

first = -10 : last = 10 : inc = 0.001

max_d = 128

epsilon = 1.0 / CDbl(max_d)

For x = first To last Step inc

y = x

ToFraction(n, d, y, max_d)

z = y + CDbl(n) / CDbl(d)

If abs(x-z) > epsilon Then Print "Incorrectly Converted " & x & " to " & z

Next

End Sub

Although I pretty much ignored the starting code, I wanted to preserve the input and output formats from the initial macro even if they are nothing alike.

Listing 5.65: Convert decimal feet to a string.

REM [-]feet'-inches n/d"

REM No part is returned if it is zero.

Function DecimalFeetToString64(ByVal x#) As String

'I only use 64, because this is what it was in the original

DecimalFeetToString64 = DecimalFeetToString(x, 64)

End Function

Function DecimalFeetToString(ByVal x#, ByVal max_denominator&) As String

Dim numerator&, denominator&

Dim feet#, decInch#, s As String

s = ""

If (x < 0) Then

s = "-"

x = -x

End If

feet = Fix(x) 'Whole Feet

x = (x - feet) * 12 'Inches

ToFraction(numerator, denominator, x, max_denominator)

REM Handle some rounding issues

If (numerator = denominator AND numerator <> 0) Then

numerator = 0

x = x + 1

End If

If feet = 0 AND x = 0 AND numerator = 0Then

s = s & "0'"

Else

If feet <> 0 Then

s = s & feet & "'"

If x <> 0 OR numerator <> 0 Then s = s & "-"

End If

If x <> 0 Then

s = s & x

If numerator <> 0 Then s = s & " "

End If

If numerator <> 0 Then s = s & numerator & "/" & denominator

If x <> 0 OR numerator <> 0 Then s = s & """"

End If

DecimalFeetToString = s

End Function

Function StringToDecimalFeet(s$) As Double

REM Maximum number of tokens would include

REM <feet><'><-><inches><space><numerator></><denominator><">

REM The first token MUST be a number!

Dim tokens(8) As String '0 to 8

Dim i%, j%, num_tokens%, c%

Dim feet#, inches#, n#, d#, leadingNeg#

feet = 0 : inches = 0 : n = 0 : d = 1 : i = 1 : leadingNeg = 1.0

s = Trim(s) ' Lose leading and trailing spaces

If (Len(s) > 0) Then

If Left(s,1) = "-" Then

leadingNeg = -1.0

s = Mid(s, 2)

End If

End If

num_tokens = 0 : i = 1

Do While i <= Len(s)

Select Case Mid(s, i, 1)

Case "-", "0" To "9"

j = i

If Left(s, i, 1) = "-" Then j = j + 1

c = Asc(Mid(s, j, 1))

Do While (48 <= c AND c <= 57)

j = j + 1

If j > Len(s) Then Exit Do

c = Asc(Mid(s, j, 1))

Loop

tokens(num_tokens) = Mid(s, i, j-i)

num_tokens = num_tokens + 1

i = j

Case "'"

feet = CDbl(tokens(num_tokens-1))

tokens(num_tokens) = "'"

num_tokens = num_tokens + 1

i = i + 1

If (i <= Len(s)) Then

If Mid(s,i,1) = "-" Then i = i + 1

End If

Case """", "/", " "

tokens(num_tokens) = Mid(s, i, 1)

i = i + 1

Do While i < Len(s)

If Mid(s, i, 1) <> tokens(num_tokens) Then Exit Do

i = i + 1

Loop

If tokens(num_tokens) = "/" Then

n = CDbl(tokens(num_tokens-1))

num_tokens = num_tokens + 1

ElseIf tokens(num_tokens) = " " Then

Inches = CDbl(tokens(num_tokens-1))

ElseIf tokens(num_tokens) = """" Then

If num_tokens = 1 Then

Inches = CDbl(tokens(num_tokens-1))

ElseIf num_tokens > 1 Then

If tokens(num_tokens-2) = "/" Then

d = CDbl(tokens(num_tokens-1))

Else

Inches = CDbl(tokens(num_tokens-1))

End If

End If

End If

Case Else

'Hmm, this is an error

i = i + 1

Print "In the else"

End Select

Loop

If d = 0 Then d = 1

StringToDecimalFeet = leadingNeg * (feet + (inches + n/d)/12)

End Function

Convert number to words

Converting an integer with values from 0 to 999 into words is simple. Some different processing is required for languages other than English, however.

Listing 5.66: Convert 0 to 999 into words

Function SmallIntToText(ByVal n As Integer) As String

REM by Andrew D. Pitonyak

Dim sOneWords()

Dim sTenWords()

Dim s As String

If n > 999 Then

Print "Warning, n = " & n & " which is too large!"

Exit Function

End If

sOneWords() = Array("zero", _

"one", "two", "three", "four", "five", _

"six", "seven", "eight", "nine", "ten", _

"eleven", "twelve", "thirteen", "fourteen", "fifteen", _

"sixteen", "seventeen", "eighteen", "nineteen", "twenty")

sTenWords() = Array( "zero", "Ten", "twenty", "thirty", "fourty", _

"fifty", "sixty", "seventy", "eighty", "ninety")

s = ""

If n > 99 Then

s = sOneWords(Fix(n / 100)) & " hundred"

n = n MOD 100

If n = 0 Then

SmallIntToText = s

Exit Function

End If

s = s & " "

End If

If (n > 20) Then

s = s & sTenWords(Fix(n / 10))

n = n MOD 10

If n = 0 Then

SmallIntToText = s

Exit Function

End If

s = s & " "

End If

SmallIntToText = s & sOneWords(n)

End Function

Converting larger numbers is a bit more work. I included the names as used in the USA, UK, and Germany. I do not handle decimal values or negative numbers. This is only a macro to get you started!

Listing 5.67: Convert big numbers into words

Function NumberToText(ByVal n) As String

REM by Andrew D. Pitonyak

Dim sBigWordsUSA()

Dim sBigWordsUK()

Dim sBigWordsDE()

REM 10^100 is a googol (10 duotrigintillion)

REM This goes to 10^303, how big do you really want me to go?

sBigWordsUSA = Array( "", _

"thousand", "million", "billion", "trillion", "quadrillion", _

"quintillion", "sexillion", "septillion", _

"octillion", "nonillion", "decillion", "undecillion", "duodecillion", _

"tredecillion","quattuordecillion", "quindecillion", "sexdecillion", _

"septdecillion", "octodecillion", "novemdecillion", "vigintillion", _

"unvigintillion", "duovigintillion", "trevigintillion", _

"quattuorvigintillion", "quinvigintillion", "sexvigintillion", _

"septvigintillion", "octovigintillion", "novemvigintillion", _

"trigintillion", "untrigintillion", "duotrigintillion", _

"tretrigintillion", "quattuortrigintillion", "quintrigintillion", _

"sextrigintillion", "septtrigintillion", "octotrigintillion", _

"novemtrigintillion", "quadragintillion", "unquadragintillion", _

"duoquadragintillion", "trequadragintillion", "quattuorquadragintillion", _

"quinquadragintillion", "sexquadragintillion", "septquadragintillion", _

"octoquadragintillion", "novemquadragintillion", "quinquagintillion", _

"unquinquagintillion", "duoquinquagintillion", "trequinquagintillion", _

"quattuorquinquagintillion", "quinquinquagintillion", _

"sexquinquagintillion", "septquinquagintillion", "octoquinquagintillion", _

"novemquinquagintillion", "sexagintillion", "unsexagintillion", _

"duosexagintillion", "tresexagintillion", "quattuorsexagintillion", _

"quinsexagintillion", "sexsexagintillion", "septsexagintillion", _

"octosexagintillion", "novemsexagintillion", "septuagintillion", _

"unseptuagintillion", "duoseptuagintillion", "treseptuagintillion", _

"quattuorseptuagintillion", "quinseptuagintillion", "sexseptuagintillion", _

"septseptuagintillion", "octoseptuagintillion", "novemseptuagintillion", _

"octogintillion", "unoctogintillion", "duooctogintillion", _

"treoctogintillion", "quattuoroctogintillion", "quinoctogintillion", _

"sexoctogintillion", "septoctogintillion", "octooctogintillion", _

"novemoctogintillion", "nonagintillion", "unnonagintillion", _

"duononagintillion", "trenonagintillion", "quattuornonagintillion", _

"quinnonagintillion", "sexnonagintillion", "septnonagintillion", _

"octononagintillion", "novemnonagintillion", "centillion" _

)

sBigWordsUK() = Array( "", "thousand", _

"milliard", "billion", "billiard", "trillion", "trilliard", _

"quadrillion", "quadrilliard", "quintillion", "quintilliard", _

"sextillion", "sextilliard", "septillion", "septilliard", _

"octillion", "octilliard", "nonillion", "nonilliard", "decillion", _

"decilliard", "undecillion", "undecilliard", "dodecillion", _

"dodecilliard", "tredecillion", "tredecilliard", "quattuordecillion", _

"quattuordecilliard", "quindecillion", "quindecilliard", "sexdecillion", _

"sexdecilliard", "septendecillion", "septendecilliard", "octodecillion", _

"octodecilliard", "novemdecillion", "novemdecilliard", "vigintillion", _

"vigintilliard", "unvigintillion", "unvigintilliard", "duovigintillion", _

"duovigintilliard", "trevigintillion", "trevigintilliard", _

"quattuorvigintillion", "quattuorvigintilliard", "quinvigintillion", _

"quinvigintilliard", "sexvigintillion", "sexvigintilliard", _

"septenvigintillion", "septenvigintilliard", "octovigintillion", _

"octovigintilliard", "novemvigintillion", "novemvigintilliard", _

"trigintillion", "trigintilliard", "untrigintillion", _

"untrigintilliard", "duotrigintillion", "duotrigintilliard", _

"tretrigintillion", "tretrigintilliard", "quattuortrigintillion", _

"quattuortrigintilliard", "quintrigintillion", "quintrigintilliard", _

"sextrigintillion", "sextrigintilliard", "septentrigintillion", _

"septentrigintilliard", "octotrigintillion", "octotrigintilliard", _

"novemtrigintillion", "novemtrigintilliard", "quadragintillion", _

"quadragintilliard", "unquadragintillion", "unquadragintilliard", _

"duoquadragintillion", "duoquadragintilliard", "trequadragintillion", _

"trequadragintilliard", "quattuorquadragintillion", _

"quattuorquadragintilliard", "quinquadragintillion", _

"quinquadragintilliard", "sexquadragintillion", "sexquadragintilliard", _

"septenquadragintillion", "septenquadragintilliard", _

"octoquadragintillion", "octoquadragintilliard", _

"novemquadragintillion", "novemquadragintilliard", "quinquagintillion", _

"quinquagintilliard" _

)

sBigWordsDE() = Array( "", "Tausand", _

"Milliarde", "Billion", "Billiarde", "Trillion", "Trilliarde", _

"Quadrillion", "Quadrilliarde", "Quintillion", "Quintilliarde", _

"Sextillion", "Sextilliarde", "Septillion", "Septilliarde", _

"Oktillion", "Oktilliarde", "Nonillion", "Nonilliarde", _

"Dezillion", "Dezilliarde", "Undezillion", "Undezilliarde", _

"Duodezillion", "Doudezilliarde", "Tredezillion", _

"Tredizilliarde", "Quattuordezillion", "Quattuordezilliarde", _

"Quindezillion", "Quindezilliarde", "Sexdezillion", _

"Sexdezilliarde", "Septendezillion", "Septendezilliarde", _

"Oktodezillion", "Oktodezilliarde", "Novemdezillion", _

"Novemdezilliarde", "Vigintillion", "Vigintilliarde", _

"Unvigintillion", "Unvigintilliarde", "Duovigintillion", _

"Duovigintilliarde", "Trevigintillion", "Trevigintilliarde", _

"Quattuorvigintillion", "Quattuorvigintilliarde", "Quinvigintillion", _

"Quinvigintilliarde", "Sexvigintillion", "Sexvigintilliarde", _

"Septenvigintillion", "Septenvigintilliarde", "Oktovigintillion", _

"Oktovigintilliarde", "Novemvigintillion", "Novemvigintilliarde", _

"Trigintillion", "Trigintilliarde", "Untrigintillion", _

"Untrigintilliarde", "Duotrigintillion", "Duotrigintilliarde", _

"Tretrigintillion", "Tretrigintilliarde", "Quattuortrigintillion", _

"Quattuortrigintilliarde", "Quintrigintillion", "Quintrigintilliarde", _

"Sextrigintillion", "Sextrigintilliarde", "Septentrigintillion", _

"Septentrigintilliarde", "Oktotrigintillion", "Oktotrigintilliarde", _

"Novemtrigintillion", "Novemtrigintilliarde", "Quadragintillion", _

"Quadragintilliarde", "Unquadragintillion", "Unquadragintilliarde", _

"Duoquadragintillion", "Duoquadragintilliarde", "Trequadragintillion", _

"Trequadragintilliarde", "Quattuorquadragintillion", _

"Quattuorquadragintilliarde", "Quinquadragintillion", _

"Quinquadragintilliarde", "Sexquadragintillion", _

"Sexquadragintilliarde", "Septenquadragintillion", _

"Septenquadragintilliarde", "Oktoquadragintillion", _

"Oktoquadragintilliarde", "Novemquadragintillion", _

"Novemquadragintilliarde", "Quinquagintillion", "Quinquagintilliarde" _

)

Dim i As Integer

Dim iInt As Integer

Dim s As String

Dim dInt As Double

REM Chop off the decimal portion.

dInt = Fix(n)

If (dInt < 1000) Then

NumberToText = SmallIntToText(CInt(dInt))

Exit Function

End If

REM i is the index into the sBigWords array

i = 0

s = ""

Do While dInt > 0

iInt = CInt(dInt - Fix(dInt / 1000) * 1000)

If iInt <> 0 Then

If Len(s) > 0 Then s = " " & s

s = SmallIntToText(iInt) & " " & sBigWordsUSA(i) & s

End If

i = i + 1

dInt = Fix(dInt / 1000)

'Print "s = " & s & " dInt = " & dInt

Loop

NumberToText = s

End Function

Sending Email

OOo provides a means of sending email but it must be properly configured, especially form Linux. OOo uses an existing client email program rather than directly supporting the email protocols. On first installation, it should know how to use some common email clients such as Mozilla/Netscape, Evolution, and K-Mail. On Windows, OOo uses MAPI so all MAPI compatible clients should work. You need to use “com.sun.star.system.SimpleSystemMail”. The SimpleCommandMail uses system command line tools to send mail, but I have only gotten this service to work on Linux. The following example was provided by Laurent Godard.

Listing 5.68: Send email.

Sub SendSimpleMail()

Dim vMailSystem, vMail, vMessage

'vMailSystem = createUnoService( "com.sun.star.system.SimpleCommandMail" )

vMailSystem=createUnoService("com.sun.star.system.SimpleSystemMail")

vMail=vMailSystem.querySimpleMailClient()

'You want to know what else you can do with this, see

'http://api.openoffice.org/docs/common/ref/com/sun/star/system/XSimpleMailMessage.html

vMessage=vMail.createsimplEmailMessage()

vMessage.setrecipient("andrew@pitonyak.org")

vMessage.setsubject("This is my test subject")

'Attachements are set by a sequence which in basic means an array

'I could use ConvertToURL() to build the URL!

Dim vAttach(0)

vAttach(0) = "file:///c:/macro.txt"

vMessage.setAttachement(vAttach())

'DEFAULTS Launch the currently configured system mail client.

'NO_USER_INTERFACE Do not show the interface, just do it!

'NO_LOGON_DIALOG No logon dialog but will throw an exception if one is required.

vMail.sendSimpleMailMessage(vMessage, _

com.sun.star.system.SimpleMailClientFlags.NO_USER_INTERFACE)

End Sub

Neither the SimpleSystemMail, nor the SimpleCommandMail service are able to send an email text body. According to Mathias Bauer, the intent of these services was to deliver a document as an attachment. It is possible to use a “mailto” URL, to send an email message with a text body, but this does not contain an attachment. The idea is let the operating system pass the mailto URL to the default object that can hopefully parse the entire text. Support for this method are dependent upon the operating system and the installed software.

Listing 5.69: Send email using a URL.

Dim noargs()

email_dispatch_url = "mailto:demo@someplace.com?subject=Test&Body=Text"

dispatcher = createUnoService( "com.sun.star.frame.DispatchHelper")

dispatcher.executeDispatch( StarDesktop,email_dispatch_url, "", 0, noargs())

According to Daniel Juliano (daniel.juliano@rainhail.com), the message size is limited by the operating system. With Windows 2000, the limit seems to be close to 500 characters. If the size is exceeded, the email is not sent and an error does NOT occur. (Andrew Pitonyak suspects that the message size is limited because it is sent as a command line. Different command interpreters support different command line lengths. For example, 4NT probably supports a longer command line than the command line provided by Microsoft.)

If running on Windows using Outlook, you can easily send body text and attachements as you desire.

Listing 5.70: Send email using Microsoft Outlook

Sub UseOutlook( )

Dim oOLEService

Dim oOutlookApp

Dim oOutlookMail

oOLEService = createUnoService("com.sun.star.bridge.OleObjectFactory")

oOutlookApp = oOLEService.createInstance("Outlook.Application")

oOutlookMail = oOutlookApp.CreateItem(0)

REM I can directly set the recipients by setting the To property

oOutlookMail.To = "andrew@pitonyak.org"

REM I can also add to the list, but in my experiments, this access the

REM mail box so Outlook asks me if I can do this. In other words, it then

REM requires user interaction. I can probably set the security in outlook

REM to simply allow this, but then I have opened things for virus activity.

'oOutlookMail.Recipients.Add("andrew@pitonyak.org")

oOutlookMail.Subject = "Test Subject"

oOutlookMail.Body = "This is my body text for the email message"

REM You can also add attachements to the message

'oOutlookMail.Attachments.Add("C:\foo.txt")

REM I can display and edit the message

'oOutlookMail.Display()

REM Or I can send the message

'oOutlookMail.send()

End Sub

Libraries

This section discusses how to use and distribute (install) macro libraries.

Russ Phillips is the author of a very good "Macro Library How-To" available from http://www.ooomacros.org. The how-to document discusses creating and using libraries from the OOo GUI.

If OOo is installed in the directory “C:\Program Files\OpenOffice”, then the directory “C:\Program Files\OpenOffice\user\basic\” contains the macro libraries that you create. This directory contains the files Script.xlc and Dialog.xlc, which reference the libraries that are visible in OOo. If library exists, but you can not see it, it is probably because of a problem in one of these two files.

Each library created in the Basic IDE is represented as a directory with the same name as the library. Each library is referenced in the Script.xlc and Dialog.xlc files. The directory “C:\Program Files\OpenOffice\share\basic\” contains the macro libraries included with OOo. Each library folder contains the modules with the .xba or .xdl filename extensions as well as script.xlb and dialog.xlb, which list the modules contained in the library. Each libraries is linked to a specific document or to the OOo application – you might hear the terms global (application level) and local scope (document level).

The library container

Prior to version 1.0, LibraryContainer was available in Basic and not in any any other language. The "com.sun.star.script.ApplicationScriptLibraryContainer" service opens the libraries to languages other than Basic, but the service is not officially published – it is considered bad practice to use unpublished interfaces and services. See the “com.sun.star.script.XLibraryContainer” interface to learn how to use this service.

The BasicLibraries variable, available only from Basic, references the Basic libraries stored in ThisComponent. Likewise, the DialogLibraries variable references the dialog libraries stored in ThisComponent. The application level libraries are available using GlobalScope.BasicLibraries and GlobalScope.DialogLibraries.

Warning	The document's libraries are also available using the deprecated method getLibraryContainer() and its corresponding property LibraryContainer. This is also the only way to access the libraries in Basic, for a document that is NOT ThisComponent.

The following example demonstrates how to manipulate libraries using the ApplicationScriptLibraryContainer.

Listing 5.71: Using the ApplicationScriptLibraryContainer.

Sub LibContainer()

REM Christian Junker

Dim allLibs()

Const newlib as String = "dummy" 'define the name of your new library

oLibCont = createUnoService("com.sun.star.script.ApplicationScriptLibraryContainer")

'create a new library

If (Not oLibCont.hasByName(newlib)) Then

oLibCont.CreateLibrary(newlib)

End If

'check if it is loaded, if not load it!

If (Not oLibCont.isLibraryLoaded(newlib)) Then

oLibCont.loadLibrary(newlib)

End If

'set a password for it (must not be read-only)

oLibCont.setLibraryReadOnly(newlib, False)

oLibCont.changeLibraryPassword(newlib, "", "password")

MsgBox "The password: ""password"" was set for library " & newlib

'show me all libraries including my new one:

allLibs = oLibCont.getElementNames()

ShowArray(allLibs()) 'this function is very useful, it's in the Tools Library

'now remove the library (must not be read-only)

oLibCont.removeLibrary(newlib)

'show all libraries now without the "dummy" one because it wasd deleted

allLibs = oLibCont.getElementNames()

ShowArray(allLibs())

'MsgBox oLibCont.dbg_Methods

End Sub

Unfortunately, renaming a library during runtime did not work in this example.

Warning about unpublished services

The ApplicationScriptLibraryContainer service is neither published nor documented. According to Jürgen Schmidt from Sun, There are probably good reasons that a service is not published. Although you found and can use the service, it may change because it is not officially published. In the future we will document unpublished APIs, but they will be marked and should be carefully used. We learned that it is sometimes better to have some experience with an API and obtain feedback before the API is published, because published means “not changeable”. Even the “best” design may require changes.

What does it means to load a Library?

When a library is loaded, the contained macros are made visible to the Basic engine. It is at this time, that the XML files are loaded and the macros are compiled. In other words, if a library is not loaded, you can not call the subroutines, functions, or dialogs that it contains. You do not want to load all of the libraries, because you usually do not use all of the macros and so it would waste space. The Standard library, however, is always loaded and available.

Distribute/deploy a library

Adding a macro to a document is the easiest way to share a library. If, however, you have numerous macros that you want to deploy for the entire application, the pkgchk tool might be preferred. The pkgchk is also used to register components that you have written in languages other than Basic. The simple explanation is that pkgchk packages (the abbreviation pkgchk means packagecheck) libraries into one collection which is stored as a .zip file in the “C:\Program Files\OpenOffice\user\uno-packages\” directory. If the “--shared” parameter is used, then the collection is stored in the “C:\Program Files\OpenOffice\share\uno-packages\” directory instead. Use the following steps to create the zip file:

Copy your library folder (or library folders) into a temporary directory.

Zip the libraries into using your favorite zip program. Be certain to preserve the directory structure.

Find the pkgchk program – it is located in the program directory off of the OpenOffice.org installation directory.

To install the “mymacros.zip” package run “pkgchk -shared mymacros.zip” – you probably need to provide the complete path to the file “mymacros.zip”. The macros should be installed in the shared UNO packages directory.

Some code written by Sunil Menon provides an example of this process using a macro. [Andrew Pitonyak notes: I do this differently in my book using BasicLibraries and such]

Listing 5.72: Deploy a macro using the ApplicationScriptLibraryContainer.

'author: Sunil Menon

'email: sunil.menon@itb-india.com

Set service_name = "com.sun.star.script.ApplicationScriptLibraryContainer"

Set oLibLoad = objServiceManager.createInstance(service _name)

If Not oLibLoad Is Nothing Then

On Error Resume Next

If oLibLoad.isLibraryLoaded("mymacros") Then

oLibLoad.removeLibrary ("mymacros")

End If

spath = "file:///D|/StarOfficeManual/mymacros"

slib = "mymacros"

Call oLibLoad.CreateLibraryLink(slib, spath, False)

oLibLoad.loadLibrary ("mymacros")

oLibLoad = Nothing

End If

If the macro already exists, then it must be registered again before the new library will be seen. This is accomplished by unloading and then reloading the library. The CreateLibraryLink method creates a link to an external library accessible using the library manager. The format of the StorageURL is implementation dependent. The boolean parameter is a read only flag.

Setting Bitmap Size

If you load an image, the size may not be as you desire. Vance Lankhaar first brought this problem to my attention. His first solution produced a very small image.

Listing 5.73: Insert a GraphicObjectShape.

'Author: Vance Lankhaar

'email: vlankhaar@linux.ca

Dim oDesktop As Object, oDocument As Object

Dim mNoArgs()

Dim sGraphicURL As String

Dim sGraphicService As String, sUrl As String

Dim oDrawPages As Object, oDrawPage As Object

Dim oGraphic As Object

sGraphicURL = "http://api.openoffice.org/branding/images/logonew.gif"

sGraphicService = "com.sun.star.drawing.GraphicObjectShape"

sUrl = "private:factory/simpress"

oDesktop = createUnoService("com.sun.star.frame.Desktop")

oDocument = oDesktop.loadComponentFromURL(sUrl,"_default",0,mNoArgs())

oDrawPages = oDocument.DrawPages

oDrawPage = oDrawPages.insertNewByIndex(1)

oGraphic = oDocument.createInstance(sGraphicService)

oGraphic.GraphicURL = sGraphicURL

oDrawPage.add(oGraphic)

The first solution by Laurent Godard sets the size to the maximum allowable size.

Listing 5.74: Set a graphic to the maximum supported size.

'Maximum size, lose the aspect ration.

Dim TheSize As New com.sun.star.awt.Size

Dim TheBitmapSize As New com.sun.star.awt.Size

Dim TheBitmap as object

Dim xmult as double, ymult as double

TheBitmap=oGraphic.GraphicObjectFillBitmap

TheBitmapSize=TheBitmap.GetSize

xmult=TwipsPerPixelX/567*10*100 '567 twips = 1 cm *1*100 for 1/100th mm ymult=TwipsPerPixelY/567*10*100

TheSize.width=TheBitmapSize.width*xmult

TheSize.height=TheBitmapSize.height*ymult

oGraphic.setsize(TheSize)

Vance Lankhaar's final solution maximizes the size but preserves the aspect ratio.

Listing 5.75: Set a graphic to the maximum supported size preserving the aspect ratio.

oBitmap = oGraphic.GraphicObjectFillBitmap

aBitmapSize = oBitMap.GetSize

iWidth = aBitmapSize.Width

iHeight = aBitmapSize.Height

iPageWidth = oDrawPage.Width

iPageHeight = oDrawPage.Height

dRatio = CDbl(iHeight) / CDbl(iWidth)

dPageRatio = CDbl(iPageHeight) / CDbl(iPageWidth)

REM This is is fit-maximum-dimension

REM s/</>/ for fit-minimum-dimension

If (dRatio < dPageRatio) Then

aSize.Width = iPageWidth

aSize.Height = CInt(CDbl(iPageWidth) * dRatio)

Else

aSize.Width = CInt(CDbl(iPageHeight) / dRatio)

aSize.Height = iPageHeight

End If

aPosition.X = (iPageWidth - aSize.Width)/2

aPosition.Y = (iPageHeight - aSize.Height)/2

oGraphic.SetSize(aSize)

oGraphic.SetPosition(aPosition)

Insert, size, and position a graphic in a Calc document.

David Woody [dwoody1@airmail.net] needed to insert a graphics object at a specific position at a specific size. With a little help and a lot of work, he developed the following solution:

This reply took some time because I had another problem to solve with setting the correct value for the X and Y coordinates. The following code inserts a graphic, sizes it, and moves it to the desired location. I had to add the following line to the code in Andrew's macro book in section the section on setting bitmap size.

Dim aPosition As New com.sun.star.awt.Point

The other problem I had was that I had to determine the ratio that was needed for aPosition.X and aPosition.Y to properly position the graphic. On my computer the value of 2540 for either X or Y coordinate = 1 inch on the screen. The values below will put the graphic 1 inch down from the top of the sheet and 1 inch over from the left of the sheet.

Listing 5.76: Insert and position a graphic in a Calc document.

Sub InsertAndPositionGraphic

REM Get the sheet

Dim vSheet

vSheet = ThisComponent.Sheets(0)

REM Add the graphics object

Dim oDesktop As Object, oDocument As Object

Dim mNoArgs()

Dim sGraphicURL As String

Dim sGraphicService As String, sUrl As String

Dim oDrawPages As Object, oDrawPage As Object

Dim oGraphic As Object

sGraphicURL = "file:///usr/local/openoffice1.1RC/share/gallery/bullets/blkpearl.gif"

sGraphicService = "com.sun.star.drawing.GraphicObjectShape"

oDrawPage = vSheet.getDrawPage()

oGraphic = ThisComponent.createInstance(sGraphicService)

oGraphic.GraphicURL = sGraphicURL

oDrawPage.add(oGraphic)

REM Size the object

Dim TheSize As New com.sun.star.awt.Size

TheSize.width=400

TheSize.height=400

oGraphic.setsize(TheSize)

REM Position the object

Dim aPosition As New com.sun.star.awt.Point

aPosition.X = 2540

aPosition.Y = 2540

oGraphic.setposition(aPosition)

End Sub

Export an image at a specified size

This from Sven Jacobi [Sven.Jacobi@sun.com]

Although it is not documented in the Developer's Guide, as of OOo 1.1, it is possible to export an image at a specified resolution. The MediaDescriptor in each graphic filter supports the “FilterData” property sequence, which sets the image size in pixels using the properties PixelWidth and PixelHeight. The logical size can be set in units of 1/100 mm using the properties LogicalWidth and LogicalHeight.

[Andy adds] This uses the GraphicExportFilter, which is only able to export a shape, shapes, or a draw page. The macro shown below, obtains the object to export as the selected object. In a Writer document, for example, a selected inserted graphic is not a shape; it is a TextGraphicObject.

Listing 5.77: Export current page as a graphic at a specified size.

Sub ExportCurrentPageOrSelection

REM Filter dependent filter properties

Dim aFilterData (4) As New com.sun.star.beans.PropertyValue

Dim sFileUrl As String

aFilterData(0).Name = "PixelWidth"

aFilterData(0).Value = 1000

aFilterData(1).Name = "PixelHeight"

aFilterData(1).Value = 1000

aFilterData(2).Name ="LogicalWidth"

aFilterData(2).Value = 1000

aFilterData(3).Name ="LogicalHeight"

aFilterData(3).Value = 1000

aFilterData(4).Name ="Quality"

aFilterData(4).Value = 60

sFileUrl = "file:///d:/test2.jpg"

REM A smart person would force this to be a Draw or Impress document

xDoc = ThisComponent

xView = xDoc.currentController

xSelection = xView.selection

If isEmpty( xSelection ) Then

xObj = xView.currentPage

Else

xObj = xSelection

End If

Export( xObj, sFileUrl, aFilterData() )

End Sub

Sub Export( xObject, sFileUrl As String, aFilterData )

Dim xExporter

xExporter = createUnoService( "com.sun.star.drawing.GraphicExportFilter" )

xExporter.SetSourceDocument( xObject )

Dim aArgs (2) As New com.sun.star.beans.PropertyValue

Dim aURL As New com.sun.star.util.URL

aURL.complete = sFileUrl

aArgs(0).Name = "MediaType"

aArgs(0).Value = "image/jpeg"

aArgs(1).Name = "URL"

aArgs(1).Value = aURL

aArgs(2).Name = "FilterData"

aArgs(2).Value = aFilterData

xExporter.filter( aArgs() )

End Sub

Draw a Line in a Calc Document

David Woody [dwoody1@airmail.net] provides the following:

Be aware that TheSize variables are relative to the aPosition variable so that if you want x1 = 500 and x2 = 2000 then TheSize.width = x2 - x1. Similarly for the Y coordinate.

Listing 5.78: Draw a line in a Calc document.

Sub DrawLineInCalcDocument

Dim xPage as object, xDoc as object, xShape as object

Dim aPosition As New com.sun.star.awt.Point

Dim TheSize As New com.sun.star.awt.Size

xDoc = thiscomponent

xPage = xDoc.DrawPages(0)

xShape = xDoc.createInstance( "com.sun.star.drawing.LineShape" )

xShape.LineColor = rgb( 255, 0, 0 )

xShape.LineWidth = 100

aPosition.X = 2500

aPosition.Y = 2500

xShape.setPosition(aPosition)

TheSize.width = 2500

TheSize.height=5000

xShape.setSize(TheSize)

xPage.add( xShape )

End Sub

Extracting a Zip File

Laurent Godard [listes.godard@laposte.net] strikes again with this solution. I modified his post.

Hi all,

Thank you very much for your Help! Combining the different advices you all gave, I finally managed to make it work ! The point is to handle the content of the input stream as OOo's API does : don't care what it is !

To solve my problem I set an OutputStream and write my InputStream in it, That's all. And it seems to work (tested on a text file, but should work otherwise ...). So as promised, here is a first shot of my macro to UNZIP a known file in a ZIP package. There remains a lot to do but it can perhaps help .... Andrew, you can use this in your macro Doc.

Thanks again for all you help

Laurent Godard.

Listing 5.79: Unzip a file.

**************************

Sub UnzipAFile(ZipURL as string, SrcFileName as string, DestFile as string)

Dim bExists as boolean

ozip=createUnoService("com.sun.star.packages.Package")

Dim args1(0)

args1(0)=ConvertToURL(ZipURL)

ozip.initialize(args1())

'does srcFile exists ?

bExists=ozip.HasByHierarchicalName(SrcFileName)

if not bExists then exit sub

'retreive a Packagestream

ThePackageStream=ozip.GetByHierarchicalName(SrcFileName)

'Retreive the InputStream on SrcFileName

MyInpuStream=ThePackageStream.GetInputStream()

'Define the outpu

oFile = createUnoService("com.sun.star.ucb.SimpleFileAccess")

oFile.WriteFile(ConvertToURL(DestFile),MyInpuStream)

'Its Done !!!

End Sub

Another Zip File Example

Dan Juliano <daniel.juliano@rainhail.com> <djuliano@dmacc.edu> expands on the example by Laurent Godard. The following example extracts all of the files from a zip file.

Listing 5.80: Extract all files in a zip file.

' Test usage for the following subs

call unzipFileFromArchive("c:\test.zip", "test.txt", "c:\test.txt")

call unzipArchive("c:\test.zip", "c:\")

Sub unzipFileFromArchive( _

strZipArchivePath As String, _

strSourceFileName As String, _

strDestinationFilePath As String)

Dim blnExists As Boolean

Dim args(0) As Variant

Dim objZipService As Variant

Dim objPackageStream As Variant

Dim objOutputStream As Variant

Dim objInputStream As Variant

Dim i As Integer

'=================================================================================

' Unzip a single file from an archive. You must know the exact name of the file

' inside the archive before this sub can dig it out.

'

' strZipArchivePath = full path (directory and filename) to the .zip archive file.

' strSourceFileName = the name of the file being dug from the .zip archive.

' strDestinationFilePath = full path (directory and filename) where the source

' file will be dumped.

'=================================================================================

' Create a handle to the zip service,

objZipService = createUnoService("com.sun.star.packages.Package")

args(0) = ConvertToURL(strZipArchivePath)

objZipService.initialize(args())

' Does the source file exist?

If Not objZipService.HasByHierarchicalName(strSourceFileName) Then Exit Sub

' Get the file input stream from the archive package stream.

objPackageStream = objZipService.GetByHierarchicalName(strSourceFileName)

objInputStream = objPackageStream.GetInputStream()

' Define the output.

objOutputStream = createUnoService("com.sun.star.ucb.SimpleFileAccess")

objOutputStream.WriteFile(ConvertToURL(strDestinationFilePath), objInputStream)

End Sub

Sub unzipArchive( _

strZipArchivePath As String, _

strDestinationFolder As String)

Dim args(0) As Variant

Dim objZipService As Variant

Dim objPackageStream As Variant

Dim objOutputStream As Variant

Dim objInputStream As Variant

Dim arrayNames() As Variant

Dim strNames As String

Dim i As Integer

'========================================================================================

' Unzip the an entire .zip archive to a destination directory.

'

' strZipArchivePath = full path (directory and filename) to the .zip archive file.

' strDestinationFilePath = folder (directory only) where the source files will be dumped.

'========================================================================================

' Create a handle to the zip service,

objZipService = createUnoService("com.sun.star.packages.Package")

args(0) = ConvertToURL(strZipArchivePath)

objZipService.initialize(args())

' Grab a package stream containing the entire archive.

objPackageStream = objZipService.GetByHierarchicalName("")

' Grab a listing of all files in the archive.

arrayNames = objPackageStream.getElementNames()

' Run through each file in the name array and pipe from archive to destination folder.

For i = LBound(arrayNames) To UBound(arrayNames)

strNames = strNames & arrayNames(i) & Chr(13)

' Read in and pump out one file at a time to the filesystem.

objInputStream = objZipService.GetByHierarchicalName(arrayNames(i)).GetInputStream()

objOutputStream = createUnoService("com.sun.star.ucb.SimpleFileAccess")

objOutputStream.WriteFile(ConvertToURL(strDestinationFolder & arrayNames(i)),_

objInputStream)

Next

MsgBox strNames

End Sub

Zip Entire Directories

Laurent Godard provides this example as well. This macro zips the content of a directory respecting subdirectories

Listing 5.81: Create a zip file.

'----------------------------------------------------------------------

sub ExempleAppel

call ZipUnRepertoire("C:\MesFichiers\Ooo\Rep","C:\resultat.zip")

end sub

'----------------------------------------------------------------------

sub ZipUnRepertoire(source as string, cible as string)

'Author: laurent Godard - listes.godard@laposte.net

dim retour() as string

'création de l'instance du fichier Zip

LeFichierZip=createUnoService("com.sun.star.packages.Package")

dim args(0)

args(0)=ConvertToURL(cible)

LeFichierZip.initialize(args())

'création de la structure des repertoires dans le zip

call Recursedirectory(source, retour)

dim argsDir(0)

argsDir(0)=true

'on saute le premier --> repertoire contenant

'Pourra etre une option a terme

Repbase=retour(1)

For i=2 To UBound(retour)

chaine=mid(retour(i),len(repbase)+2)

decoupe=split(mid(retour(i),len(repbase)+1),getPathSeparator)

repZip=decoupe(UBound(decoupe))

azipper=LeFichierZip.createInstanceWithArguments(argsDir())

If len(chaine)<>len(repZip) then

RepPere=left(chaine,len(chaine)-len(repZip)-1)

RepPere=RemplaceChaine(reppere, getpathseparator, "/", false)

Else

RepPere=""

Endif

RepPereZip=LeFichierZip.getByHierarchicalName(RepPere)

RepPereZip.insertbyname(repzip, azipper)

Next i

'insertion des fichiers dans les bons repertoires

dim args2(0)

args2(0)=false

oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")

for i=1 to UBound(retour)

chaine=mid(retour(i),len(repbase)+2)

repzip=remplacechaine(chaine, getpathseparator, "/", false)

fichier=dir(retour(i)+getPathSeparator,0)

While fichier<>""

azipper=LeFichierZip.createInstanceWithArguments(args2())

oFile = oUcb.OpenFileRead(ConvertToURL(retour(i)+"/"+fichier))

azipper.SetInputStream(ofile)

RepPere=LeFichierZip.getByHierarchicalName(repZip)

RepPere.insertbyname(fichier, azipper)

fichier=dir()

Wend

next i

'Valide les changements

LeFichierZip.commitChanges()

msgbox "C'est fini"

End Sub

'----------------------------------------------------------------------

sub RecurseDirectory(chemin, reponse as variant)

'Author: laurent Godard - listes.godard@laposte.net

'reponse est un tableau contenant la liste de tous les sous répertoires de chemin

redim preserve reponse(1 to 1)

compte=1

reponse(1)=chemin

repbase=1

rep=dir(convertTourl(chemin+"/"),16)

while rep<>""

if rep<>"." and rep<>".." then

compte=compte+1

redim preserve reponse(1 to compte)

reponse(compte)=convertfromurl(reponse(RepBase)+"/"+rep)

endif

rep=dir()

while rep="" and repbase<compte

repbase=repbase+1

rep=dir(convertToURL(reponse(repbase)+"/"),16)

wend

wend

End Sub

'----------------------------------------------------------------------

Function RemplaceChaine(ByVal chaine As String, src As String, dest As String,_

casse As Boolean)

'Auteurs: Laurent Godard & Bernard Marcelly

' fournit une chaine dont toutes les occurences de src ont été remplacées par dest

'casse = true pour distinguer majuscules/minuscules, = false sinon

Dim lsrc As Integer, i As Integer, kas As Integer

dim limite as string

limite=""

kas = iif(casse, 0, 1)

lsrc = len(src)

i = instr(1, chaine, src, kas)

while i<>0

while i<0

limite=limite+left(chaine,32000)

chaine=mid(chaine,32001)

i=instr(1, chaine, src, kas)

wend

' ici i est toujours positif non nul

if i>1 then

limite = limite + Left(chaine, i-1) +dest

else ' ici i vaut toujours 1

limite = limite +dest

endif

' raccourcir en deux temps car risque : i+src > 32767

chaine = Mid(chaine, i)

chaine = Mid(chaine, 1+lsrc)

i = instr(1, chaine, src, kas)

wend

RemplaceChaine = limite + chaine

End Function

Run a macro by string name

A given macro subroutine or function name can be called using the dispatch API. This is useful when the precise routine to call is not definable when the macro is initially written. Consider, for example, a list of routines to call that is held in an external file. Thanks to Paolo Mantovani for the following solution:

Listing 5.82: Run a macro based on the value in a string.

Sub TestDispatch

Dim mNoArgs()

oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

sMacroURL = "macro:///Gimmicks.AutoText.Main"

oDispatcher.executeDispatch(StarDesktop, sMacroURL, "", 0, mNoArgs())

End Sub

Using a “default application” to open a file

When I use a Windows computer, the first thing that I do is to install 4NT from JP Software (http://www.jpsoft.com) because I use the command line. When I want to open a PDF file, I simply type the name of the file and press enter. Windows looks at the file extension and then automatically opens a PDF reader. The GUI equivalent is to double click on a file and the is opened in the correct software.

You can accomplish the same thing using OOo by using the SystemShellExecute service. (Thanks to Russ Phillips [avantman42@users.sourceforge.net] for pointing me to Erik Anderson's findings http://www.oooforum.org/forum/viewtopic.php?t=6657)

The magic is performed by the SystemShellExecute service, which contains one method; execute!

Listing 5.83: Open a file based on the default application.

Sub LaunchOutsideFile()

Dim oSvc as object

oSvc = createUnoService("com.sun.star.system.SystemShellExecute")

Rem File:

' oSvc.execute(ConvertToUrl("C:\sample.txt"), "", 0)

Rem Folder:

' oSvc.execute(ConvertToUrl("C:\Program Files\OpenOffice.org1.1.0"), "", 0)

Rem Web address:

' oSvc.execute("http://www.openoffice.org/", "", 0)

Rem Email:

' oSvc.execute("mailto:anonymous@ftp.com", "", 0)

End Sub

Listing Fonts

The available fonts are known by the container window. The getFontDescriptors() method returns an array of AWT FontDescriptor structures that contain a lot of information about the font. The font descriptor can be passed to the getFont() method, which returns an object that supports the AWT XFont interface. The XFont interface provides methods to determine font metrics, and the width of an individual character or an entire string of characters.

Listing 5.84: List fonts.

Sub ListFonts

Dim oWindow 'The container window supports the awt XDevice interface.

Dim oDescript 'Array of awt FontDescriptor structures

Dim s$ 'Temporary string variable to hold all of the string names.

Dim i% 'General index variable

oWindow = ThisComponent.getCurrentController().getFrame().getContainerWindow()

oDescript = oWindow.getFontDescriptors()

s = ""

For i = LBound(oDescript) to UBound(oDescript)

s = s & oDescript(i).Name & ", "

Next

MsgBox s

End Sub

Get the document URL, filename, and directory

Do not try to obtain the document URL unless it has a URL. If the document has not yet been stored, for example. Rather than write my own routines, I use some functions in the Strings Module stored in the Tools library.

Listing 5.85: Extracting file and path information from a URL.

REM Author: Andrew Pitonyak

Sub DocumentFileNames

Dim oDoc

Dim sDocURL

oDoc = ThisComponent

If (Not GlobalScope.BasicLibraries.isLibraryLoaded("Tools")) Then

GlobalScope.BasicLibraries.LoadLibrary("Tools")

End If

If (oDoc.hasLocation()) Then

sDocURL = oDoc.getURL()

Print "Document Directory = " & DirectoryNameoutofPath(sDocURL, "/")

Print "Document File Name = " & FileNameoutofPath(sDocURL, "/")

End If

End Sub

Get and set the current directory

In OOo, ChDir and ChDrive currently do nothing – this is intentional. The following is based on a discussion between Andreas Bregas, Christian Junker, Paolo Mantovani and Andrew Pitonyak.

Initially, the ChDir and ChDrive statements made file system calls, but they were rewritten using the UCB layer – as was all file system related functionality. This is why all of the commands now also accept URL notation. Support for a current working directory is not supported by the UCB and the underlying sal/osl API because of the inherent problems (bugs) in a multi threaded environment. In Windows, for example, the File Open dialog changes the process' current working directory, as do other API calls. You expect the current working directory to be one thing, but then another thread changes it. Paolo recommends the use of the PathSettings service, which contains numerous path values (see Table 5.3).

Table 5.3. Properties supported by the com.sun.star.util.PathSettings service.

Property	Description
Backup	Automatic backup copies of documents are stored here.
Basic	The Basic files, used by the AutoPilots, can be found here. The value can be more than one path separated by a semicolon.
Favorite	Path to save folder bookmarks
Gallery	Location of the Gallery database and multimedia files. The value can be more than one path separated by a semicolon.
Graphic	This directory is displayed when the dialog for opening a graphic or for saving a new graphic is called.
Help	The path to the Office help files.
Module	This is the path for the modules.
Storage	Mail, News files and other information (for example, about FTP Server) are stored here.
Temp	The base URL to the office temp-files
Template	The templates originate from these folders and sub-folders. The value can be more than one path separated by a semicolon.
UserConfig	Folder that contains the user settings.
Work	User's work folder, which can be modified – used by the Open and Save dialogs.

The following code clarifies how this works:

Listing 5.86: Use the PathSettings service.

Author: Paolo Mantovani

Function pmxCurDir() As String

Dim oPathSettings

oPathSettings = CreateUnoService("com.sun.star.util.PathSettings")

'The path of the work folder can be modified according to the user's needs.

'The path specified here can be seen in the Open or Save dialog.

pmxCurDir = oPathSettings.Work

End Function

Function pmxChDir(sNewDir As String) As String

Dim oPathSettings

oPathSettings = CreateUnoService("com.sun.star.util.PathSettings")

oPathSettings.Work = ConvertToUrl(sNewDir)

pmxChDir = oPathSettings.Work

End Function

There is also a com.sun.star.util.PathSubstitution service, which provides access to many interesting path related values. The path variables are not case sensitive and are always returned as a UCB-compliant URL, for example, “file:///c:/temp” or “file:///usr/install”. The supported list of values are stored in the Office configuration file (org/openoffice/Office/Substitution.xml). The variables with predefined values are as follows:

Table 5.4. Variables recognized by the the com.sun.star.util.PathSubstitution service.

Variable	Description
$(inst)	Installation path of the Office.
$(prog)	Program path of the Office.
$(user)	The user installation directory.
$(work)	The user's work directory of the user. Under Windows this is the "MyDocuments" subdirectory. Under Unix this is the home-directory
$(home)	The user's home directory of the user. Under Unix this is the home-directory. Under Windows this is the "Documents and Settings " subdirectory.
$(temp)	The current temporary directory.
$(path)	The value of PATH environment variable.
$(lang)	The country code used by the Office, like 01=english, 49=german.
$(langid)	The language code used by the Office, like 0x0009=english, 0x0409=english us.
$(vlang)	The language used by the Office as a string. Like "german" for a German Office.

Listing 5.87: Use the PathSubstitution service.

oPathSubst = createUnoService("com.sun.star.util.PathSubstitution")

Print oPathSubst.getSubstituteVariableValue("$(inst)")

Writing to a file

The methods provided directly by BASIC contains certain flaws and interesting behavior. I take an entire chapter to discuss this in my book. I recently found the following little snippet by Christian Junker that I will need to explore sometime. You can set the text encoding use the setEncoding() method.

Listing 5.88: SimpleFileAccess allows you to set the output format.

fileAccessService = createUnoService("com.sun.star.ucb.SimpleFileAccess")

textOutputStream = createUnoService("com.sun.star.io.TextOutputStream")

'now open the file..

outputStream = fileAccessService.openFileWrite(<yourFileName>)

outputStream.truncate()

textOutputStream.setOutputStream(outputStream)

'now write something into the file

textOutputStream.writeString("This is utf-8 format.")

'and don't forget to close it..

textOutputStream.closeOutput()

Parsing XML

A wonderful example of parsing XML is provided by DannyB on the oooforum (see http://www.oooforum.org/forum/viewtopic.php?t=4907). You should read this before using the following macro:

Listing 5.89: Parsing XML.

Sub Main

cXmlFile = "C:\TestData.xml"

cXmlUrl = ConvertToURL( cXmlFile )

ReadXmlFromUrl( cXmlUrl )

End Sub

' This routine demonstrates how to use the Universal Content Broker's

' SimpleFileAccess to read from a local file.

Sub ReadXmlFromUrl( cUrl )

' The SimpleFileAccess service provides mechanisms to open, read, write files,

' as well as scan the directories of folders to see what they contain.

' The advantage of this over Basic's ugly file manipulation is that this

' technique works the same way in any programming language.

' Furthermore, the program could be running on one machine, while the SimpleFileAccess

' accesses files from the point of view of the machine running OOo, not the machine

' where, say a remote Java or Python program is running.

oSimpleFileAccess = createUnoService( "com.sun.star.ucb.SimpleFileAccess" )

' Open input file.

oInputStream = oSimpleFileAccess.openFileRead( cUrl )

ReadXmlFromInputStream( oInputStream )

oInputStream.closeInput()

End Sub

Sub ReadXmlFromInputStream( oInputStream )

' Create a Sax Xml parser.

oSaxParser = createUnoService( "com.sun.star.xml.sax.Parser" )

' Create a document event handler object.

' As methods of this object are called, Basic arranges

' for global routines (see below) to be called.

oDocEventsHandler = CreateDocumentHandler()

' Plug our event handler into the parser.

' As the parser reads an Xml document, it calls methods

' of the object, and hence global subroutines below

' to notify them of what it is seeing within the Xml document.

oSaxParser.setDocumentHandler( oDocEventsHandler )

' Create an InputSource structure.

oInputSource = createUnoStruct( "com.sun.star.xml.sax.InputSource" )

With oInputSource

.aInputStream = oInputStream ' plug in the input stream

End With

' Now parse the document.

' This reads in the entire document.

' Methods of the oDocEventsHandler object are called as

' the document is scanned.

oSaxParser.parseStream( oInputSource )

End Sub

'==================================================

' Xml Sax document handler.

'==================================================

' Global variables used by our document handler.

'

' Once the Sax parser has given us a document locator,

' the glLocatorSet variable is set to True,

' and the goLocator contains the locator object.

'

' The methods of the locator object has cool methods

' which can tell you where within the current Xml document

' being parsed that the current Sax event occured.

' The locator object implements com.sun.star.xml.sax.XLocator.

'

Private goLocator As Object

Private glLocatorSet As Boolean

' This creates an object which implements the interface

' com.sun.star.xml.sax.XDocumentHandler.

' The doucment handler is returned as the function result.

Function CreateDocumentHandler()

' Use the CreateUnoListener function of Basic.

' Basic creates and returns an object that implements a particular interface.

' When methods of that object are called,

' Basic will call global Basic functions whose names are the same

' as the methods, but prefixed with a certian prefix.

oDocHandler = CreateUnoListener( "DocHandler_", "com.sun.star.xml.sax.XDocumentHandler" )

glLocatorSet = False

CreateDocumentHandler() = oDocHandler

End Function

'==================================================

' Methods of our document handler call these

' global functions.

' These methods look strangely similar to

' a SAX event handler. ;-)

' These global routines are called by the Sax parser

' as it reads in an XML document.

' These subroutines must be named with a prefix that is

' followed by the event name of the com.sun.star.xml.sax.XDocumentHandler interface.

'==================================================

Sub DocHandler_startDocument()

Print "Start document"

End Sub

Sub DocHandler_endDocument()

' Print "End document"

End Sub

Sub DocHandler_startElement( cName As String, oAttributes As com.sun.star.xml.sax.XAttributeList )

Print "Start element", cName

End Sub

Sub DocHandler_endElement( cName As String )

' Print "End element", cName

End Sub

Sub DocHandler_characters( cChars As String )

End Sub

Sub DocHandler_ignorableWhitespace( cWhitespace As String )

End Sub

Sub DocHandler_processingInstruction( cTarget As String, cData As String )

End Sub

Sub DocHandler_setDocumentLocator( oLocator As com.sun.star.xml.sax.XLocator )

' Save the locator object in a global variable.

' The locator object has valuable methods that we can

' call to determine

goLocator = oLocator

glLocatorSet = True

End Sub

DannyB recommends starting with a small file for your initial tests:

<Employees>

<Employee id="101">

<Name>

<First>John</First>

<Last>Smith</Last>

</Name>

<Address>

<Street>123 Main</Street>

<City>Lawrence</City>

<State>KS</State>

<Zip>66049</Zip>

</Address>

<Phone type="Home">785-555-1234</Phone>

</Employee>

<Employee id="102">

<Name>

<First>Bob</First>

<Last>Jones</Last>

</Name>

<Address>

<Street>456 Puke Drive</Street>

<City>Lawrence</City>

<State>KS</State>

<Zip>66049</Zip>

</Address>

<Phone type="Home">785-555-1235</Phone>

</Employee>

</Employees>

Manipulating Dates

My book contains complete coverage of dates, along with all of their idiosyncrasies. Remember that the fractional portion represents the time and the decimal portion represents the days. You can, therefore, simply add in the number of days to a date object to increment the current day.

Listing 5.90: Adding two days together is easy.

Function addDays(StartDate as Date, nDays As Integer) As Date

REM To add days, simply add them in

addDay = StartDate + nDays

End Function

Although adding days to a date is easy, there are complications when adding years or months. February had 29 days in 2004 and 28 days in 2005. You can not, therefore, simply add one to the year and be safe; similar problems exist for the month. You must decide what it means to add one to the year or month. The initial routine was provided by Eric VanBuggenhaut, did not properly handle these situations. Antoine Jarrige noticed incorrect behavior and provided a solution, but problems still remained while adding 12 months to a date in December.

I did an almost complete rewrite using tricks presented in my Macro book. The final code first adds years and months. When adding years and months, an initial date that starts as the last day of the month, stays on the last day of the month. When this is completed, the days are added. If this is not what you desire, then change the macro.

The SumDate function adds the specified number of years, months, and days to a date variable. The primary disadvantages to this routine is that it drops the time component and does not properly handle dates with a year value below 100.

Listing 5.91: Add years, months, and days to a date.

Function SumDate_new(StartDate as Date, nYears% , nMonths%, nDays%) as Date

REM Author: Eric Van Buggenhaut [Eric.VanBuggenhaut@AdValvas.be]

REM Modified by Antoine Jarrige [pierre-antoine.jarrige@laposte.net]

REM Almost complete rewrite by Andrew Pitonyak [andrew@pitonyak.org]

Dim lDateValue As Long ' The start date represented as a long integer

Dim nDateDay As Integer ' The day for the start date.

Dim nDateMonth As Integer ' The month.

Dim nDateYear As Integer ' The year.

Dim nLastDay_1 As Integer ' Last day of the month for the initial date.

Dim nLastDay_2 As Integer ' Last day of the month for the target date.

REM Determine the year, month, and day

nDateDay = Day(StartDate)

nDateMonth = Month(StartDate)

nDateYear = Year(StartDate)

REM Find the last day of the month.

If nDateMonth = 12 Then

REM December always has 31 days

nLastDay_1 = 31

Else

nLastDay_1 = Day(DateSerial(nDateYear, nDateMonth+1, 1)-1)

End If

REM Adding a year is only a problem on February 29th of a leap year.

nDateYear = nDateYear + nYears

nDateMonth = nDateMonth + nMonths

If nDateMonth > 12 Then

nDateYear = nDateYear + (nDateMonth - 1) \ 12

nDateMonth = (nDateMonth - 1) MOD 12 + 1

End If

REM Find the last day of the month.

If nDateMonth = 12 Then

REM December always has 31 days

nLastDay_2 = 31

Else

nLastDay_2 = Day(DateSerial(nDateYear, nDateMonth+1, 1)-1)

End If

REM Force the last day of the month to stay on the last day of the month,

REM and do not allow an overflow into the next month.

REM The concern is that adding one month to Jan 31 will end up in March.

If nDateDay = nLastDay_1 OR nDateDay > nLastDay_2 Then nDateDay = nLastDay_2

REM While adding days, however, all bets are off.

SumDate_new = CDate(DateSerial(nDateYear, nDateMonth, nDateDay) + nDays)

End Function

Is OpenOffice embedded into a web browser?

OpenOffice can open a document directly into your web browser. OpenOffice supports an undocumented (and internally used) property, isPlugged, which indicates if the desktop is plugged into a browser.

Stardesktop.isPlugged()

Although it works in OOo version 1.1.2, the rumor is that the isPlugged method will be removed by version 2.0.

Focus (bring to the front) a new document

To cause the document referenced by the variable oDoc2 to become the focused document, use either of the two methods:

Listing 5.92: Make the current window active.

oDoc2.CurrentController.Frame.ContainerWindow.toFront()

oDoc2.CurrentController.Frame.Activate()

This will not change the value of ThisComponent.

Accessing the clipboard

Most people access the clipboard using UNO dispatch commands. Sometimes, however, you need to access the clipboard directly. Listing 5.93 demonstrates how to access the clipboard as text. Too busy to explain how this code works.

Listing 5.93: View the clipboard as text.

Sub ViewClipBoard

Dim oClip, oClipContents, oTypes

Dim oConverter, convertedString$

Dim i%, iPlainLoc%

iPlainLoc = -1

oClip = createUnoService("com.sun.star.datatransfer.clipboard.SystemClipboard")

oConverter = createUnoService("com.sun.star.script.Converter")

' Print "Clipboard name = " & oClip.getName()

' Print "Implemantation name = " & oClip.getImplementationName()

oClipContents = oClip.getContents()

oTypes = oClipContents.getTransferDataFlavors()

Dim msg$, iLoc%, outS

msg = ""

iLoc = -1

For i=LBound(oTypes) To UBound(oTypes)

If oTypes(i).MimeType = "text/plain;charset=utf-16" Then

iPlainLoc = i

Exit For

End If

'msg = msg & "Mime type = " & x(ii).MimeType & " normal = " & _

' x(ii).HumanPresentableName & Chr$(10)

Next

If (iPlainLoc >= 0) Then

convertedString = oConverter.convertToSimpleType( _

oClipContents.getTransferData(oTypes(iPlainLoc)), _

com.sun.star.uno.TypeClass.STRING)

MsgBox convertedString

End If

End Sub

What is the document type (based on URL)

Christian Junker noted that you can use “deep” type detection to determine a document's type. This means that the correct type is returned even if the file extension is not. In other words, it will detect a Calc document with a .doc extension. The returned string is the internal format name.

Listing 5.94: Determine a document's type.

Sub DetectDocType()

Dim oMediaDescr(30) As new com.sun.star.beans.PropertyValue

Dim oTypeManager

oMediaDescr(0).Name = "URL"

oMediaDescr(0).Value = ThisComponent.getURL()

oTypeManager = createUnoService("com.sun.star.document.TypeDetection")

REM Perform a deep type detection (not just based on filename extension)

MsgBox oTypeManager.queryTypeByDescriptor(oMediaDescr(), True)

End Sub

Connect to a remote OOo server using Basic

You can connect to a remote OOo server using Basic.

Listing 5.95: Determine a document's type.

Sub connectToRemoteOffice()

REM Author: Christian Junker

REM Author: Modified by Andrew Pitonyak

Dim sURL$ ' Connection URL to the remote host.

Dim sHost$ ' IP address running the remote host.

Dim sPort$ ' Port used on the remote host.

Dim oRes ' URL Resolver.

Dim oRemote ' Remote manager for the remote server.

Dim oDesk ' Desktop object from the remote server.

Dim oDoc ' The opened document.

REM Set the host and port running the server.

REM The host must have started a server listening on the specified port:

REM If you do not specify "host=0", it will not accept connections from the network.

REM "soffice -accept=socket,host=0,port=8100;urp;StarOffice.ServiceManager"

sHost = "192.168.0.5"

sPort = "8100"

sURL = "uno:socket,host=" & sHost & _

",port=" & sPort & _

";urp;StarOffice.ServiceManager"

oRes = createUNOService("com.sun.star.bridge.UnoUrlResolver")

oRemote = oRes.resolve(sURL)

oDesk = oRemote.createInstance("com.sun.star.frame.Desktop")

REM Specify the document to open!

sURL = "private:factory/swriter"

'sURL = "file:///home/andy/PostData.doc"

oDoc = oDesk.loadComponentFromURL(sURL, "_blank", 0, Array())

Print "The document is now open"

End Sub

Something else to consider: have you looked at oood.py? A simple daemon for OpenOffice.org. http://udk.openoffice.org/python/oood/

Calc macros

Is this a spreadsheet document?

A spreadsheet document is composed of a set of sheets. Before you can use the spreadsheet specific methods, you must have a spreadsheet document. You may verify this as follows:

Listing 6.1: Is this a Calc document, using error handling.

Function IsSpreadsheetDoc(oDoc) As Boolean

On Local Error GoTo NODOCUMENTTYPE

IsSpreadsheetDoc = oDoc.SupportsService("com.sun.star.sheet.SpreadsheetDocument")

NODOCUMENTTYPE:

If Err <> 0 Then

IsSpreadsheetDoc = False

Resume GOON

GOON:

End If

End Function

If error handling is not an issue because the function will never be called with a null or empty argument, and the object will always implement the supportsService() method then you can use this version:

Listing 6.2: Is this a Calc document with no error handling.

Function IsSpreadsheetDoc(oDoc) As Boolean

IsSpreadsheetDoc = oDoc.SupportsService("com.sun.star.sheet.SpreadsheetDocument")

End Function

You can call the test method as follows:

Sub checking( )

MsgBox IsSpreadsheetDoc(thisComponent)

End Sub

Display cell value, string, or formula

Listing 6.3: Accessing a cell in a Calc document.

'******************************************************************

'Author: Sasa Kelecevic

'email: scat@teol.net

Sub ExampleGetValue

Dim oDocument As Object, oSheet As Object, oCell As Object

oDocument=ThisComponent

oSheet=oDocument.Sheets.getByName("Sheet1")

oCell=oSheet.getCellByposition(0,0) 'A1

Rem a cell's contents can have one of the three following types:

Print oCell.getValue()

'Print oCell.getString()

'Print oCell.getFormula()

End Sub

Set cell value, format, string, or formula

Listing 6.4: Accessing a cell in a Calc document.

'******************************************************************

'Author: Sasa Kelecevic

'email: scat@teol.net

Sub ExampleSetValue

Dim oDocument As Object, oSheet As Object, oCell As Object

oDocument=ThisComponent

oSheet=oDocument.Sheets.getByName("Sheet1")

oCell=oSheet.getCellByPosition(0,0) 'A1

oCell.setValue(23658)

'oCell.NumberFormat=2 '23658.00

'oCell.SetString("oops")

'oCell.setFormula("=FUNCTION()")

'oCell.IsCellBackgroundTransparent = TRUE

'oCell.CellBackColor = RGB(255,141,56)

End Sub

Reference a cell in another document

In your spreadsheet, you can access a cell in another document using a form similar to

file:///PATH/filename'#$Data.P40

This can also be done when setting a formula in a macro.

oCell = thiscomponent.sheets(0).getcellbyposition(0,0) ' A1

oCell.setFormula("=" &"'file:///home/USER/CalcFile2.sxc'#$Sheet2.K89")

Clear a cell

A list of things that can be cleared can be found at http://api.openoffice.org/docs/common/ref/com/sun/star/sheet/CellFlags.html

Listing 6.5: Clear a cell.

'******************************************************************

'Author: Andrew Pitonyak

'email: andrew@pitonyak.org

Sub ClearDefinedRange

Dim oDocument As Object, oSheet As Object, oSheets As Object

Dim oCellRange As Object

Dim nSheets As Long

oDocument = ThisComponent

oSheets = oDocument.Sheets

nSheets = oDocument.Sheets.Count

oSheet = oSheets.getByIndex(2) REM the range is from 0 to n-1

oCellRange = oSheet.getCellRangeByName("<range_you_set>") 'for example "A1:B2"

oCellRange.clearContents(_

com.sun.star.sheet.CellFlags.VALUE | _

com.sun.star.sheet.CellFlags.DATETIME | _

com.sun.star.sheet.CellFlags.STRING | _

com.sun.star.sheet.CellFlags.ANNOTATION | _

com.sun.star.sheet.CellFlags.FORMULA | _

com.sun.star.sheet.CellFlags.HARDATTR | _

com.sun.star.sheet.CellFlags.STYLES | _

com.sun.star.sheet.CellFlags.OBJECTS | _

com.sun.star.sheet.CellFlags.EDITATTR)

End Sub

Selected text, what is it?

Selected text in a spreadsheet can be a few different things; some of them I understand and some I do not.

One cell Selected. Click in a cell once and then hold down the shift key and click in the cell again.

Partial text in a single cell selected. Double click in a single cell and then select some text.

Nothing selected. Single click in a cell or tab between cells.

Multiple cells selected. Single click in a cell and then drag the cursor.

Multiple disjoint selections. Select some cells. Hold down the control key and select some more.

So far, I have not been able to distinguish the first three cases. If I can figure out how to extract the selected text in case 2, then I can solve this problem.

Listing 6.6: Is anything selected in a Calc document.

Function CalcIsAnythingSelected(oDoc As Object) As Boolean

Dim oSelections As Object, oSel As Object, oText As Object, oCursor As Object

IsAnythingSelected = False

If IsNull(oDoc) Then Exit Function

' The current selection in the current controller.

'If there is no current controller, it returns NULL.

oSelections = oDoc.getCurrentSelection()

If IsNull(oSelections) Then Exit Function

If oSelections.supportsService("com.sun.star.sheet.SheetCell") Then

Print "One Cell selected = " & oSelections.getImplementationName()

MsgBox "getString() = " & oSelections.getString()

ElseIf oSelections.supportsService("com.sun.star.sheet.SheetCellRange") Then

Print "One Cell Range selected = " & oSelections.getImplementationName()

ElseIf oSelections.supportsService("com.sun.star.sheet.SheetCellRanges") Then

Print "Multiple Cell Ranges selected = " & oSelections.getImplementationName()

Print "Count = " & oSelections.getCount()

Else

Print "Somethine else selected = " & oSelections.getImplementationName()

End If

End Function

Get the active cell and ignore the rest

If you want only the cell that contains the cursor, and you want to ignore the rest, you can tell the controller to select an empty range that was created by the document. The following subroutine does the following:

Save the current selection. This is useful if more than a single cell is active.

Select an empty range so that only the cell with the cursor is selected. The cell is selected with an outline around the cell, but it is not completely blacked out. If you use the controller to select a range, this method can also be used to change the selection from a completely selected cell, to merely an active cell.

Use the CellAddressConversion service to obtain the address of the active cell. This is new to 1.1.1, part of the "linked controls" implementation.

Listing 6.7: Find the active cell.

REM Author: Paolo Mantovani

REM email: mantovani.paolo@tin.it

Sub RetrieveTheActiveCell()

Dim oOldSelection 'The original selection of cell ranges

Dim oRanges 'A blank range created by the document

Dim oActiveCell 'The current active cell

Dim oConv 'The cell addres conversion service

REM store the current selection

oOldSelection = ThisComponent.CurrentSelection

oRanges = ThisComponent.createInstance("com.sun.star.sheet.SheetCellRanges")

ThisComponent.CurrentController.Select(oRanges)

'get the active cell!

oActiveCell = ThisComponent.CurrentSelection

REM a nice service I've just found!! :-)

oConv = ThisComponent.createInstance("com.sun.star.table.CellAddressConversion")

oConv.Address = oActiveCell.getCellAddress

Print oConv.UserInterfaceRepresentation

Print oConv.PersistentRepresentation

'restore the old selection (but loosing the previous active cell)

ThisComponent.CurrentController.Select(oOldSelection)

End Sub

Human readable address of cell

The com.sun.star.table.CellAddressConversion service can be used to obtain a human readable text string that represents the address of a cell. I have not found any documentation on this service, but as of OOo 1.1.1, it seems to work well enough. The following code snippet assumes that the current document is a Calc document, and that only a single cell is selected.

Listing 6.8: Cell address in a readable form using CellAddressConversion.

oActiveCell = ThisComponent.getCurrentSelection()

oConv = ThisComponent.createInstance("com.sun.star.table.CellAddressConversion")

oConv.Address = oActiveCell.getCellAddress

Print oConv.UserInterfaceRepresentation

Print oConv.PersistentRepresentation

I created the following function before I knew about the CellAddressConversion service.

Listing 6.9: Cell address in a readable form.

'Given a cell, extract the normal looking address of a cell

'First, the name of the containing sheet is extracted.

'Second, the column number is obtained and turned into a letter

'Lastly, the row is obtained. Rows start at 0 but are displayed as 1

Function PrintableAddressOfCell(the_cell As Object) As String

PrintableAddressOfCell = "Unknown"

If Not IsNull(the_cell) Then

PrintableAddressOfCell = the_cell.getSpreadSheet().getName + ":" + _

ColumnNumberToString(the_cell.CellAddress.Column) + (the_cell.CellAddress.Row+1)

End If

End Function

' Columns are numbered starting at 0 where 0 corresponds to A

' They run as A-Z,AA-AZ,BA-BZ,...,IV

' This is esentially a question of how do you convert a Base 10 number to

' a base 26 number.

' Note that the_column is passed by value!

Function ColumnNumberToString(ByVal the_column As Long) As String

Dim s$

'Save this so I do NOT modify the parameter.

'This was an icky bug that took me a while to find

Do while the_column >= 0

s$ = Chr(65 + the_column MOD 26) + s$

the_column = the_column \ 26 - 1

Loop

ColumnNumberToString = s$

End Function

Insert formatted date into cell

Insert the date into the current cell. An error message is displayed if the current document is not a spreadsheet. Code is provided to format the date in the style of your choice, you need to remove the comments. A final warning, this macro assumes that only a single sell is selected and it will fail if this is not the case. If you want to deal with the possibility of having more than one cell selected, then look at the section that deals with selected text in a Calc document.

Listing 6.10: Formatted date in a cell.

'******************************************************************

'Author: Andrew Pitonyak

'email: andrew@pitonyak.org

'uses: FindCreateNumberFormatStyle

Sub InsertDateIntoCell

Dim oSelection 'The currently selected cell

Dim oFormats 'Available formats

REM Verify that this is a Calc document

If ThisComponent.SupportsService("com.sun.star.sheet.SpreadsheetDocument") Then

oSelection = ThisComponent.CurrentSelection

Rem Set the time, date, or date and time

'oSelection.setValue(DateValue(Now())) 'Set only the date

'oSelection.setValue(TimeValue(Now())) 'Set only the time

oSelection.setValue(Now()) 'Set the date and time

Rem I could use FunctionAccess to set the date and/or time.

'Dim oFunction 'Use FunctionAccess service to call the Now function

'oFunction = CreateUnoService("com.sun.star.sheet.FunctionAccess")

'oFunction.NullDate = ThisComponent.NullDate

'oSelection.setValue(oFunction.callFunction("NOW", Array()))

Rem Set the date number format to default

oFormats = ThisComponent.NumberFormats

Dim aLocale As New com.sun.star.lang.Locale

oSelection.NumberFormat = oFormats.getStandardFormat(_

com.sun.star.util.NumberFormat.DATETIME, aLocale)

Rem Set the format to something completely different

'oSelection.NumberFormat = FindCreateNumberFormatStyle(_

' "YYYYMMDD.hhmmss", doc)

Else

MsgBox "This macro must be run in a spreadsheet document"

End If

End Sub

A shorter way to do it

Consider the following two methods (provided by Shez):

Listing 6.11: Formatted date in a cell with a shorter method.

Sub DateNow

Dim here As Object

here=ThisComponent.CurrentSelection

here.setValue(DateValue(Now))

here.NumberFormat=75

End sub

Sub TimeNow

Dim here As Object

here=ThisComponent.CurrentSelection

here.setValue(TimeValue(Now))

here.NumberFormat=41

End sub

These two methods assume a Calc document and hard code the display format.

Display selected range in message box

Listing 6.12: Display selected range.

'******************************************************************

'Author: Sasa Kelecevic

'email: scat@teol.net

'This macro will take the current selection and print a message

'box indicating the selected range and the number of selected

'cells

Sub SelectedCells

oSelect=ThisComponent.CurrentSelection.getRangeAddress

oSelectColumn=ThisComponent.CurrentSelection.Columns

oSelectRow=ThisComponent.CurrentSelection.Rows

CountColumn=oSelectColumn.getCount

CountRow=oSelectRow.getCount

oSelectSC=oSelectColumn.getByIndex(0).getName

oSelectEC=oSelectColumn.getByIndex(CountColumn-1).getName

oSelectSR=oSelect.StartRow+1

oSelectER=oSelect.EndRow+1

NoCell=(CountColumn*CountRow)

If CountColumn=1 AND CountRow=1 Then

MsgBox("Cell " + oSelectSC + oSelectSR + chr(13) + "Cell No = " + NoCell,, "SelectedCells")

Else

MsgBox("Range(" + oSelectSC + oSelectSR + ":" + oSelectEC + oSelectER + ")" + chr(13) + "Cell No = " + NoCell,, "SelectedCells")

End If

End Sub

Fill selected range with text

This simple macro iterates through the selected rows and columns setting the text to “OOPS”.

Listing 6.13: Iterate through cells and set the text.

'******************************************************************

'Author: Sasa Kelecevic

'email: scat@teol.net

Sub FillCells

oSelect=ThisComponent.CurrentSelection

oColumn=oselect.Columns

oRow=oSelect.Rows

For nc= 0 To oColumn.getCount-1

For nr = 0 To oRow.getCount-1

oCell=oselect.getCellByPosition (nc,nr).setString ("OOOPS")

Next nr

Next nc

End Sub

Although this loop technique is frequently used with no complaints, it might be faster to set all of the values at one time using the method setDataArray().

Some stats on a selected range

Listing 6.14: Information about the selected range.

'******************************************************************

'Author: Sasa Kelecevic

'email: scat@teol.net

'This macro will take the current selection and print a message

'box indicating the selected range and the number of selected

'cells

Sub Analize

sSum="=SUM("+GetAddress+")"

sAverage="=AVERAGE("+GetAddress+")"

sMin="=MIN("+GetAddress+")"

sMax="=MAX("+GetAddress+")"

CellPos(7,6).setString(GetAddress)

CellPos(7,8).setFormula(sSum)

CellPos(7,8).NumberFormat=2

CellPos(7,10).setFormula(sAverage)

CellPos(7,10).NumberFormat=2

CellPos(7,12).setFormula(sMin)

CellPos(7,12).NumberFormat=2

CellPos(7,14).setFormula(sMax)

CellPos(7,14).NumberFormat=2

End sub

Function GetAddress 'selected cell(s)

oSelect=ThisComponent.CurrentSelection.getRangeAddress

oSelectColumn=ThisComponent.CurrentSelection.Columns

oSelectRow=ThisComponent.CurrentSelection.Rows

CountColumn=oSelectColumn.getCount

CountRow=oSelectRow.getCount

oSelectSC=oSelectColumn.getByIndex(0).getName

oSelectEC=oSelectColumn.getByIndex(CountColumn-1).getName

oSelectSR=oSelect.StartRow+1

oSelectER=oSelect.EndRow+1

NoCell=(CountColumn*CountRow)

If CountColumn=1 AND CountRow=1 then

GetAddress=oSelectSC+oSelectSR

Else

GetAddress=oSelectSC+oSelectSR+":"+oSelectEC+oSelectER

End If

End Function

Function CellPos(lColumn As Long,lRow As Long)

CellPos= ActiveSheet.getCellByPosition (lColumn,lRow)

End Function

Function ActiveSheet

ActiveSheet=StarDesktop.CurrentComponent.CurrentController.ActiveSheet

End Function

Sub DeleteDbRange(sRangeName As String)

oRange=ThisComponent.DatabaseRanges

oRange.removeByName (sRangeName)

End Sub

Database range

I modified the following macros by declaring all variables and adding improved error checking. I also created the following test routine.

Listing 6.15: Test the define and remove database range routine.

Sub TestDefineAndRemoveRange

Dim s As String

Dim oDoc

oDoc = ThisComponent

s = "blah1"

If oDoc.DatabaseRanges.hasByName(s) Then Print "It already Exists"

MsgBox Join(oDoc.DatabaseRanges.getElementNames(), CHR$(10)), 0, "Before Adding " & s

DefineDbRange(s)

MsgBox Join(oDoc.DatabaseRanges.getElementNames(), CHR$(10)), 0, "After Adding " & s

DeleteDbRange(s)

MsgBox Join(oDoc.DatabaseRanges.getElementNames(), CHR$(10)), 0, "After Removing " & s

End Sub

Set selected cells to a database range

Listing 6.16: Set selected cells to a database range.

'Author: Sasa Kelecevic

'email: scat@teol.net

'Modified by : Andrew Pitonyak

Sub DefineDbRange(sRangeName As String) 'selected range

Dim oSelect

Dim oRange

Dim oRanges

On Error GoTo DUPLICATENAME

oSelect=ThisComponent.CurrentSelection.RangeAddress

oRanges = ThisComponent.DatabaseRanges

If oRanges.hasByName(sRangeName) Then

MsgBox("Duplicate name",,"INFORMATION")

Else

oRange= oRanges.addNewByName (sRangeName,oSelect)

End If

DUPLICATENAME:

If Err <> 0 Then

MsgBox("Error adding database name " & sRangeName,,"INFORMATION")

End If

End Sub

Delete database range

Listing 6.17: Delete a database range.

'******************************************************************

'Author: Sasa Kelecevic

'email: scat@teol.net

'Modified by : Andrew Pitonyak

Sub DeleteDbRange(sRangeName As String)

Dim oRanges

oRanges=ThisComponent.DatabaseRanges

If oRanges.hasByName(sRangeName) Then

oRanges.removeByName(sRangeName)

End If

End Sub

Table borders

When a structure is obtained from a service, a copy of the structure is returned rather than a reference to the structure. This prevents you from directly modifying the structure. Instead, you must make a copy of the structure, modify it, and then copy it back (see Listing 6.18).

Listing 6.18: Set Calc border using a temporary.

'******************************************************************

'Author: Niklas Nebel

'email: niklas.nebel@sun.com

' setting_borders_in_calc

oRange = ThisComponent.Sheets(0).getCellRangeByPosition(0,1,0,63)

aBorder = oRange.TableBorder

aBorder.BottomLine = lHor

oRange.TableBorder = aBorder

Niklas included an example that fails because it modifies a temporary structure.

Listing 6.19: This fails because the TableBorder structure is a copy.

lHor.Color = 0: lHor.InnerLineWidth = 0: lHor.OuterLineWidth = 150:

Dim lHor As New com.sun.star.table.BorderLinelHor.LineDistance = 0

ThisComponent.Sheets(0).getCellRangeByPosition(0,1,0,63).TableBorder.BottomLine = lHor

And here is a working solution from David Woody [dwoody1@airmail.net]

Listing 6.20: Another example setting a Calc border.

Sub Borders

Dim aBorder As Object, oRange as object, oDoc as object, oSheets as object

Dim TableBorder As New com.sun.star.table.TableBorder

Dim aTopLine As New com.sun.star.table.BorderLine

oDoc = ThisComponent

oSheets = oDoc.Sheets(0)

oRange = oSheets.getCellRangeByPosition(8,2,8,5)

aBorder = oRange.TableBorder

aTopLine.OuterLineWidth = 250

aTopLine.InnerLineWidth = 0

aTopLine.Color = 170000

oRange.TableBorder.IsTopLineValid = 1

aBorder.TopLine = aTopLine

oRange.TableBorder = aBorder

End Sub

Sort range

The macro in Listing 6.21 performs a descending sort based on columns. In other words, the rows are moved around.

Listing 6.21: Descending sort in a Calc document.

'******************************************************************

'Author: Sasa Kelecevic

'email: scat@teol.net

Sub SortRange

Dim oSheetDSC,oDSCRange As Object

Dim aSortFields(0) As New com.sun.star.util.SortField

Dim aSortDesc(0) As New com.sun.star.beans.PropertyValue

'set your sheet name

oSheetDSC = ThisComponent.Sheets.getByName("Sheet1")

'set your range address

oDSCRange = oSheetDSC.getCellRangeByName("A1:L16")

ThisComponent.getCurrentController.select(oDSCRange)

aSortFields(0).Field = 0

aSortFields(0).SortAscending = FALSE

aSortDesc(0).Name = "SortFields"

aSortDesc(0).Value = aSortFields()

oDSCRange.Sort(aSortDesc())

End Sub

Assume that I want to sort on the second and third columns where the first column is text and the second column is to be sorted numerically. I will need two sort fields rather than one.

Sub Main

Dim oSheetDSC As Object, oDSCRange As Object

Dim aSortFields(1) As New com.sun.star.util.SortField

Dim aSortDesc(0) As New com.sun.star.beans.PropertyValue

'set your sheet name

oSheetDSC = THISCOMPONENT.Sheets.getByName("Sheet1")

'set your range address

oDSCRange = oSheetDSC.getCellRangeByName("B3:E6")

THISCOMPONENT.getCurrentController.select(oDSCRange)

'Another valid sort type is

'com.sun.star.util.SortFieldType.AUTOMATIC

'Remember that the fields are zero based so this starts sorting

'in column B, not column A

aSortFields(0).Field = 1

aSortFields(0).SortAscending = TRUE

'It turns out that there is no reason to set the field type while

'sorint in a spreadsheet document becuase this is ignored.

'A spreadsheet alraedy knows the type.

'aSortFields(0).FieldType = com.sun.star.util.SortFieldType.ALPHANUMERIC

aSortFields(1).Field = 2

aSortFields(1).SortAscending = TRUE

aSortFields(1).FieldType = com.sun.star.util.SortFieldType.NUMERIC

aSortDesc(0).Name = "SortFields"

aSortDesc(0).Value = aSortFields() ' aSortFields(0)

oDSCRange.Sort(aSortDesc()) ' aSortDesc(0)

End Sub

To specify the first row as a header row, use another property. Be certain that you dimension enough properties.

aSortDesc(1).Name = "ContainsHeader"

aSortDesc(1).Value = True

Bernard Marcelly verified that the “Orientation” property works properly. To set the orientation, use the property “Orientation” and set the value to one of the following:
com.sun.star.table.TableOrientation.ROWS
com.sun.star.table.TableOrientation.COLUMNS

When sorting using the GUI, you can not sort on more than three rows or columns at a time. Bernard Marcelly pointed out that you can not circumvent this limitation with a macro. There is a limitation of three rows or columns.

Display all data in a column

While traversing the cell and printing values, I want to print information about the cell. Here is how I did it.

Sub PrintDataInColumn (a_column As Integer)

Dim oCells As Object, aCell As Object, oDocument As Object

Dim oColumn As Object, oRanges As Object

oDocument = ThisComponent

oColumn = oDocument.Sheets(0).Columns(a_column)

Print "Using column " + oColumn.getName

oRanges = oDocument.createInstance("com.sun.star.sheet.SheetCellRanges")

oRanges.insertByName("", oColumn)

oCells = oRanges.Cells.createEnumeration

If Not oCells.hasMoreElements Then Print "Sorry, no text to display"

While oCells.hasMoreElements

aCell = oCells.nextElement

'This next Function is defined elsewhere in this document!

MsgBox PrintableAddressOfCell(aCell) + " = " + aCell.String

Wend

End Sub

Using Outline (Grouping) Methods

Ryan Nelson [ryan@aurelius-mfg.com] told me about the outline capability in Calc and then asked how to do this in a macro. There are two things to keep in mind. The first is that it is the sheet that adds and removes grouping, and the second is that the parameters must be correct.

http://api.openoffice.org/docs/common/ref/com/sun/star/sheet/XSheetOutline.html

http://api.openoffice.org/docs/common/ref/com/sun/star/table/TableOrientation.html

Option Explicit

Sub CalcGroupingExample

Dim oDoc As Object, oRange As Object, oSheet As Object

oDoc = ThisComponent

If Not oDoc.SupportsService("com.sun.star.sheet.SpreadsheetDocument") Then

MsgBox "This macro must be run from a spreadsheet document", 64, "Error"

End If

oSheet=oDoc.Sheets.getByName("Sheet1")

' Parms are (left, top, right, bottom)

oRange = oSheet.getCellRangeByPosition(2,1,3,2)

'Could also use COLUMNS

oSheet.group(oRange.getRangeAddress(), com.sun.star.table.TableOrientation.ROWS)

Print "I just grouped the range"

oSheet.unGroup(oRange.getRangeAddress(), com.sun.star.table.TableOrientation.ROWS)

Print "I just ungrouped the range"

End Sub

Protecting your data

It is easy to protect your spreadsheets, you only need to get your sheet and then protect it. My experiments indicate that although you do not generate an error when you choose to protect an entire document, it does not protect the entire document.

Sub ProtectSpreadsheet

Dim oDoc As Object, oSheet As Object

oDoc = ThisComponent

oSheet=oDoc.Sheets.getByName("Sheet1")

oSheet.protect("password")

Print "Protect value = " & oSheet.isProtected()

oSheet.unprotect("password")

Print "Protect value = " & oSheet.isProtected()

End Sub

Setting header and footer text

This macro will set the header for every sheet to “Sheet: <sheet_name>”. The headers and footers are set using identical methods, just change “Header” to “Footer” in the calls. Special thanks to Oliver Brinzing [OliverBrinzing@t-online.de] for filling in the holes that I did not know, namely that I had to write the header back into the document.

Sub SetHeaderTextInSpreadSheet

Dim oDoc as Object, oSheet as Object, oPstyle as Object, oHeader as Object

Dim oText as Object. oCursor as Object, oField as Object

oDoc = ThisComponent

' Get the pagestyle for the currently active sheet.

oSheet = oDoc.CurrentController.getActiveSheet

oPstyle = oDoc.StyleFamilies.getByName("PageStyles").getByName(oSheet.PageStyle)

' Turn headers on and then make them shared!

oPstyle.HeaderOn = True

oPstyle.HeaderShared = True

' The is also a RightText and a LeftText

oHeader = oPstyle.RightPageHeaderContent

oText = oHeader.CenterText

' You may now set the text object to be anything you desire

' Simple text may be set using the setString() method on the text object.

' but it takes a cursor to insert a field such as the current sheet name

' First, I will clear any existing text!

oText.setString("")

oCursor = oText.createTextCursor()

oText.insertString(oCursor, "Sheet: ", False)

' This will have the sheet name of the current sheet!

oField = oDoc.createInstance("com.sun.star.text.TextField.SheetName")

oText.insertTextContent(oCursor, oField, False)

' And now for the part that holds the entire thing together,

' You must write the header object back because we have been

' modifying a temporary object

oPstyle.RightPageHeaderContent = oHeader

End Sub

Access a form control in Calc via OOo Basic

Laurent Godard posted the following that I must admit to not having had enough time to look at and understand! ?? Look at this later!

How can I access a form control in Calc via OOo Basic

Form Name= "Formul"

Control Name = "TheList"

sheet Name = "Sheet 1"

I want to have the value of the selected item in "TheList" All done in a Macro in order to bind a change to a cell... Thanks to Oliver Brinzing who gave me an example

oDocument = ThisComponent

oSheets = oDocument.Sheets

oSheet = oSheets.GetByName(SheetName)

oDpage = Osheet.DrawPage

oForm = oDpage.Forms(SheetName).getByName(ControlName)

Result= oForm.text

Copying spreadsheet cells

Copy entire sheet to a new document

The following macro copies the contents of a given sheet into a newly created of a second document.

'Author: Stephan Wunderlich [stephan.wunderlich@sun.com]

Sub CopySpreadsheet

firstDoc = ThisComponent

selectSheetByName(firstDoc, "Sheet2")

dispatchURL(firstDoc,".uno:SelectAll")

dispatchURL(firstDoc,".uno:Copy")

secondDoc = StarDesktop.loadComponentFromUrl("private:factory/scalc","_blank",0,dimArray())

secondDoc.getSheets().insertNewByName("inserted",0)

selectSheetByName(secondDoc, "inserted")

dispatchURL(secondDoc,".uno:Paste")

End Sub

Sub selectSheetByName(document, sheetName)

document.getCurrentController.select(document.getSheets().getByName(sheetName))

End Sub

Sub dispatchURL(document, aURL)

Dim noProps()

Dim URL As New com.sun.star.util.URL

frame = document.getCurrentController().getFrame()

URL.Complete = aURL

transf = createUnoService("com.sun.star.util.URLTransformer")

transf.parseStrict(URL)

disp = frame.queryDispatch(URL, "", com.sun.star.frame.FrameSearchFlag.SELF _

OR com.sun.star.frame.FrameSearchFlag.CHILDREN)

disp.dispatch(URL, noProps())

End Sub

Select a named range

Use Insert | Names | Define to open the Define Names dialog. The More button expands the dialog so that you can provide more information about the range. A named range is not the same as a database range defined using Data | Define Range. The following macro displays all of the named ranges contained in a document.

oRanges = ThisComponent.NamedRanges

MsgBox "Current named ranges = " & CHR$(10) & Join(oRanges.getElementNames(), CHR$(10))

A named range supports the getReferencePosition() method, which returns a cell address identifying the upper left corner of the named range. The getContent() method of the named range returns a string representation of the named range. The GetGlobalRangeByName macro by Rob Gray, simplifies porting Excel VBA macros to OpenOffice.org.

REM Author: Rob Gray

REM Email: robberbaron@optusnet.com.au

REM Modified from a macro contained in Andrew Pitonyak's document.

REM This makes it easier to transition from VBA global ranges and to separate

REM parameters onto a Config sheet

Function GetGlobalRangeByName(rngname As String)

Dim oSheet 'Sheet containing the named range

Dim oNamedRange 'The named range object

Dim oCellAddr 'Address of the upper left cell in the named range

If NOT ThisComponent.NamedRanges.hasByName(rngname) Then

MsgBox "Sorry, the named range !"& rngname &"! does not exist","MacroError",0+48

Exit function

End If

REM The oNamedRange object supports the XNamedRange interface

oNamedRange = ThisComponent.NamedRanges.getByName(rngname)

'Print "Named range content = " & oNamedRange.getContent()

REM Get the com.sun.star.table.CellAddress service

oCellAddr = oNamedRange.getReferencePosition()

REM Now, get the sheet that matters!

oSheet = ThisComponent.Sheets.getByIndex(oCellAddr.Sheet+1)

GetGlobalRangeByName = oSheet.getCellRangeByName(rngname)

REM now can apply .GetCellByPosition(0,0).string etc

End function

My original exposure to named ranges, was to select a named range. I modified my original macro and created SelectNamedRange instead.

Sub SelectNamedRange(rngname As String, Optional oDoc)

REM Author: Andrew Pitonyak

Dim oSheet 'Sheet containing the named range

Dim oNamedRange 'The named range object

Dim oCellAddr 'Address of the upper left cell in the named range

Dim oRanges 'All of the named ranges

If IsMissing(oDoc) Then oDoc = ThisComponent

oRanges = oDoc.NamedRanges

If NOT oRanges.hasByName(rngname) Then

MsgBox "Sorry, the named range " & rngname & " does not exist" & CHR$(10) & _

"Current named ranges = " & CHR$(10) & Join(oRanges.getElementNames(), CHR$(10))

Exit Sub

End If

REM The oNamedRange object supports the XNamedRange interface

oNamedRange = oRanges.getByName(rngname)

'Print "Named range content = " & oNamedRange.getContent()

oCellAddr = oNamedRange.getReferencePosition()

REM Now, get the sheet that matters!

oSheet = oDoc.Sheets.getByIndex(oCellAddr.Sheet)

REM You can then use the current controller

REM to select what must be selected.

REM select ( VARIANT )

REM setActiveSheet ( OBJECT )

REM setFirstVisibleColumn ( LONG )

REM setFirstVisibleRow ( LONG )

oDoc.getCurrentController().setActiveSheet(oSheet)

REM The sheet can return the range based on the name

REM oSheet.getCellRangeByName(rngname)

REM The sheet can also return a range by position, if you know it.

REM This selects the ENTIRE range

oDoc.getCurrentController().select(oSheet.getCellRangeByName(rngname))

End Sub

Convert data in column format into rows

Cut and paste data from a web page containing name and address information formatted in a column as follows:

customer1

address1a

address1b

customer2

address2a

address2b

The macro shown below converts these records into a row format so that they can be used to merge data into a form letter.

Customer address1 address2

------------------------------

customer1 address1a address1b

customer2 address2a address2b

[Andy notes:] The following macro assumes that the data is located in the first sheet with the data starting in the first row and the first column. The data is located in the first row and column afterwards. I always run my macros using Option Explicit, but the variables are not declared in this macro. Although this might not be the best method, it certainly works.

REM ---Arrange Calc colum data into rows.

REM Author: David Kwok

REM Email: dkwok@iware.com.au

Sub ColumnsToRows

int_col = 0

int_row = 0

osheet = ThisComponent.Sheets.getByIndex(0)

ThisComponent.CurrentController.Select(osheet.GetCellByPosition(0,0))

Cellstring = Thiscomponent.getCurrentSelection.getstring

loop_col = int_col

loop_row = int_row

row_cnt = int_row

Do While Cellstring <> ""

col_cnt = 1

REM the end number, 3, depends on the number of fields in a record

For xx = 1 To 3

oRangeOrg = osheet.getCellByPosition(loop_col,loop_row).Rangeaddress

oRangecpy = osheet.getCellByPosition(col_cnt,row_cnt).Rangeaddress

oCellCpy = osheet.getCellByPosition(oRangecpy.StartColumn, _

oRangecpy.StartRow).CellAddress

osheet.MoveRange(oCellcpy, oRangeOrg)

col_cnt = col_cnt + 1

loop_row = loop_row + 1

Next xx

ThisComponent.CurrentController.Select(osheet.GetCellByPosition(loop_col,loop_row))

cellstring = ThisComponent.getCurrentSelection.getstring

row_cnt = row_cnt + 1

Loop

osheet.Columns.removeByIndex(0,1) 'tidying up

osheet.Rows.insertByIndex(0,1)

osheet.GetCellByPosition(0,0).string = "Customer"

osheet.GetCellByPosition(1,0).string = "Address1"

osheet.GetCellByPosition(2,0).string = "Address2"

osheet.Columns(0).OptimalWidth = true 'adjusting the width

osheet.Columns(1).OptimalWidth = true

osheet.Columns(2).OptimalWidth = true

End Sub

Toggle Automatic Calculation

Chris Clementson sent me a macro to toggle a spreadsheet automatic calculation on and off using the dispatch functionality. I only included enough to show the argument:

Dim args1(0) As New com.sun.star.beans.PropertyValue

args1(0).Name = "AutomaticCalculation"

args1(0).Value = False

dispatcher.executeDispatch(document, ".uno:AutomaticCalculation", "", 0, args1())

Calc documents implement the XCalculatable interface, which defines the methods shown in the table below.

Method	Description
calculate()	Recalculate all dirty cells.
calculate all()	Recalculate all cells.
isAutomaticCalculationEnabled()	Return True if automatic calculation is enabled.
enableAutomaticCalculation(boolean)	Enable or disable automatic calculation.

The following code disables and then enables automatic calculation:

ThisComponent.enableAutomaticCalculation(False)

ThisComponent.enableAutomaticCalculation(True)

Which cells are used in a sheet?

A SheetCellCursor implements the methods gotoStartOfUsedArea(boolean) and gotoEndOfUsedArea(boolean), which move the cursor to the start and end of the area used on a spreadsheet. Gerrit Jasper provided the following example (which he did not write):

Author: Unknown

Sub testEndColRow

Dim oSheet

Dim oCell

Dim nEndCol As Integer

Dim nEndRow As Integer

oSheet = ThisComponent.Sheets.getByIndex( 0 )

nEndCol = getLastUsedColumn(oSheet) 'see functions below

nEndRow = getLastUsedRow(oSheet)

REM Then do as you please, e.g.

oCell = oSheet.GetCellByPosition( nEndCol + 1, nEndRow + 1 )

oCell.String = "test"

ThisComponent.CurrentController.Select(oCell)

End Sub

Function getLastUsedColumn(oSheet as Object) as Integer

Dim oCell As Object

Dim oCursor As Object

Dim aAddress As Variant

oCell = oSheet.GetCellbyPosition( 0, 0 )

oCursor = oSheet.createCursorByRange(oCell)

oCursor.GotoEndOfUsedArea(True)

aAddress = oCursor.RangeAddress

GetLastUsedColumn = aAddress.EndColumn

End Function

Function getLastUsedRow(oSheet as Object) as Integer

Dim oCell As Object

Dim oCursor As Object

Dim aAddress As Variant

oCell = oSheet.GetCellbyPosition( 0, 0 )

oCursor = oSheet.createCursorByRange(oCell)

oCursor.GotoEndOfUsedArea(True)

aAddress = oCursor.RangeAddress

GetLastUsedRow = aAddress.EndRow

End Function

Searching a Calc document

Gerrit Jasper provided a macro to search a Calc document that first determines the range of cells that are used, and then obtains each cell and checks it against a string. I made several modifications:

REM Return the cell that contains the text

Function uFindString(sString$, oSheet) As Variant

Dim nCurCol As Integer

Dim nCurRow As Integer

Dim nEndCol As Integer

Dim nEndRow As Integer

Dim oCell As Object

Dim oCursor As Object

Dim aAddress As Variant

Dim sFind As String

oCell = oSheet.GetCellbyPosition( 0, 0 )

oCursor = oSheet.createCursorByRange(oCell)

oCursor.GotoEndOfUsedArea(True)

aAddress = oCursor.RangeAddress

nEndRow = aAddress.EndRow

nEndCol = aAddress.EndColumn

For nCurCol = 0 To nEndCol 'Go through the range column by column,

For nCurRow = 0 To nEndRow 'row by row.

oCell = oSheet.GetCellByPosition( nCurCol, nCurRow )

sFind = oCell.String 'Get cell contents.

If sFind = sString then

uFindString = oCell

Exit Function

End If

Next

Next

End Function

In a small sheet, I was able to find the cell that contained the text in around 1184 clock ticks. Next, I modified the macro to use a data array. Using a data array takes the time down to closer to 54 clock ticks – much faster.

REM Return the cell that contains the text

Function uFindString_2(sString$, oSheet) As Variant

Dim nCurCol As Integer

Dim nCurRow As Integer

Dim oCell As Object

Dim oCursor As Object

Dim oData

Dim oRow

oCell = oSheet.GetCellbyPosition( 0, 0 )

oCursor = oSheet.createCursorByRange(oCell)

oCursor.GotoEndOfUsedArea(True)

oData = oCursor.getDataArray()

For nCurRow = LBound(oData) To UBound(oData)

oRow = oData(nCurRow)

For nCurCol = LBound(oRow) To UBound(oRow)

If (oRow(nCurCol) = sString$) Then

uFindString_2 = oSheet.GetCellbyPosition( nCurCol, nCurRow )

Exit Function

End If

Next

Next

End Function

Searching the sheet directly is much faster at 34 ticks!

REM Find the first cell that contains sString$

REM If bWholeWord is True, then the cell must contain ONLY the text

REM as indicated. If bWholeWord is False, then the cell must only contain

REM the requested string.

Function SimpleSheetSearch(sString$, oSheet, bWholeWord As Boolean) As Variant

Dim oDescriptor

Dim oFound

REM Create a descriptor from a searchable document.

oDescriptor = oSheet.createSearchDescriptor()

REM Set the text for which to search and other

REM http://api.openoffice.org/docs/common/ref/com/sun/star/util/SearchDescriptor.html

With oDescriptor

.SearchString = sString$

REM These all default to false

REM SearchWords forces the entire cell to contain only the search string

.SearchWords = bWholeWord

.SearchCaseSensitive = False

End With

REM Find the first one

oFound = oSheet.findFirst(oDescriptor)

SimpleSheetSearch = oFound

REM Do you really want to find more instances

REM You can continue the search using a cell if you want!

'Do While Not IsNull(oFound)

' Print oFound.getString()

' oFound = oSheet.findNext( oFound, oDescriptor)

'Loop

End Function

As usual, the built in functionality is much faster than a macro coded solution. This does, however also clearly demonstrate that it usually better to obtain a chunk of data using the data array methods than to operate on one cell at a time. This is the macro that I used to check the run time:

Sub SimpleSheetSearchTest

Dim nItCount As Integer

Dim nMaxIt As Integer

Dim lTick1 As Long

Dim lTick2 As Long

Dim oSheet

Dim oCell

Dim s As String

nMaxIt = 10

oSheet = ThisComponent.getSheets().getByIndex(0)

lTick1 = GetSystemTicks()

For nItCount = 1 To nMaxIt

oCell = SimpleSheetSearch("hello", oSheet, True)

'oCell = uFindString("hello", oSheet)

'oCell = uFindString_2("hello", oSheet)

Next

lTick2 = GetSystemTicks()

s = s & "Search took " & (lTick2 - lTick1) & " ticks for " & _

nMaxIt & " iterations " & CHR$(10) & _

CStr((lTick2 - lTick1) / nMaxIt) & _

" ticks per iteration" & CHR$(10)

If IsEmpty(oCell) OR IsNull(oCell) Then

s = s & "Text not found" & CHR$(10)

Else

s = s & "col = " & oCell.CellAddress.Column & _

" row = " & oCell.CellAddress.Row & CHR$(10)

End If

MsgBox s, 0, "Compare Search Times"

End Sub

Tip	By default, the built in search capability searches based on the cell's formula ( SearchType = 0). Set the SearchType property to 1 to search based on the cell's value.
Tip	You can search a sheet, and you can also directly search a sheet cell range.

Gerrit Jasper pointed out that the SimpleSheetSearch function works equally well on a range as it does on a sheet – kind of embarrassing that I did not noticed this when I wrote the rest of this section. The following example demonstrates this capability by searching a specified range.

Sub SearchARange

REM Author: Andrew Pitonyak

Dim oSheet

Dim oRange

Dim oFoundCell

oSheet = ThisComponent.getSheets().getByIndex(0)

oRange = oSheet.getCellRangeByName("F7:H11")

oFoundCell = SimpleSheetSearch("41", oRange, False)

End Sub

Print a Calc range

The official method for printing a range in a Calc document is to set the print area for each sheet and then use the print method on the document. Although XPrintAreas interface, which is used to set the print areas, has been marked as deprecated for a while, it is still the officially sanctioned method for printing sections of a Calc document (Thanks Niklas Nebel).

David French <dfrench( at )xtra.co.nz>, a moderator on the oooforum, pointed out that when a Calc document prints, all print areas in all sheets are printed. In other words, when you set a print area, you should first clear the print areas from all sheets. Cor Nouws produced the solution shown below (based on a solution by David French). He mentions that he obtains sheets using getByName() because getByIndex() did not work well when hidden sheets were used.

'Author: Cor Nouws <cno@nouenoff.nl>

'-------------------------------------------------------------------------

Sub PrintSelectedArea (sSht$, nStC&, nStR&, nEndC&, nEndR&)

'-------------------------------------------------------------------------

Dim selArea(0) as new com.sun.star.table.CellRangeAddress

Dim oDoc as object

Dim oSheet as object

Dim oSheets

Dim i%

oDoc = Thiscomponent

oSheets = ThisComponent.Sheets

For i = 0 to oSheets.getCount() - 1

oSheet = ThisComponent.Sheets.getByIndex(i)

oSheet.setPrintareas(array())

Next

selArea(0).StartColumn = nStC

selArea(0).StartRow = nStR

selArea(0).EndColumn = nEndC

selArea(0).EndRow = nEndR

oSheet=ThisComponent.Sheets.getByName(sSht)

oSheet.setPrintareas(selArea())

oDoc.Print(Array())

End Sub

Is a cell merged?

Note: my book has some coverage on page 342. That said, When cells are merged, the merged area acts as a single cell as identified by the upper left hand corner of the merged range. The entire range will report as merged using the isMerged() function. The individual cell will also report as merged. The individual cell or the originally merged range can be used to set the merged property to false. I do not know off hand how to quickly find cells that are merged.

Sub MergeTest

Dim oCell 'Holds a cell temporarily

Dim oRange 'The primary range

Dim oSheet 'The fourth sheet

oSheet = ThisComponent.getSheets().getByIndex(0)

oRange = oSheet.getCellRangeByName("B2:D7")

oRange.merge(True)

Print "Range merged = " & oRange.isMerged() ' True

REM Now obtain a cell that was merged

REM and I can do it!

oCell = oSheet.getCellByPosition(2, 3) 'C4

Print "Cell C4 merged = " & oCell.isMerged() ' False

oCell = oSheet.getCellByPosition(1, 1) 'B2

Print "Cell B2 merged = " & oCell.isMerged() ' True

oCell.merge(False)

End Sub

Writer Macros

Selected Text, What Is It?

Selected text is essentially a text range, nothing more. After a selection is obtained, it is possible to get the text [getString()] and set the text [setString()]. Although strings are limited to 64K in size, selections are not. There are some instances, therefore, when the getString() and setString() methods have results that are not understood by myself. It is, therefore, probably better to use a cursor to traverse the selected text and then use the insertString() and insertControlCharacter() method of the text object, which supports the XText interface. The documentation specifically states that the following white space characters are supported by insertString() method: blank, tab, cr (which will insert a paragraph break), and lf (which will insert a line break).

Text may be manually selected such that the cursor is on either the left or the right of the selection. A selection has both a start and an end point and you can not know ahead of time which is on the left and which is on the right of the selected text. A method is shown below to address this problem.

See Also:

http://api.openoffice.org/docs/common/ref/com/sun/star/text/TextRange.html
http://api.openoffice.org/docs/common/ref/com/sun/star/text/XTextRange.html

Is the cursor in a text table?

It is a common misconception that you use the selected text functions to determine if the cursor is located inside of a text table. A Writer document's controller returns a view cursor that identifies the location of the cursor. The view cursor contains two properties of interest, TextTable, and Cell – each text cursor also contains the properties Textfield, TextFrame, and TextSection. Use IsNull() to check these properties to determine if the cursor is contained in a table. Be certain to experiment with multiple cells and areas selected.

Listing 7.1: Is the cursor in a text table?

Sub TableStuff

Dim oVCurs 'The view cursor

Dim oTable 'The text table that contains the text cursor.

Dim oCurCell 'The text table cell that contains the text cursor.

oVCurs = ThisComponent.getCurrentController().getViewCursor()

If IsEmpty(oVCurs.TextTable) Then

Print "The cursor is NOT in a table"

Else

oTable = oVCurs.TextTable

oCurCell = oVCurs.Cell

Print "The cursor is in cell " & oCurCell.CellName

End If

End Sub

Can I check the current selection for a TextTable or Cell?

[Andy notes: this section is premature so be certain to read the rest of section 7.1]

If I place the cursor inside of a text table and I do not select the entire cell, then the current selection is a TextRanges object. The selected text from the cell is represented by a TextRange object. The TextRange object has a TextTable property and a Cell property. These two properties are not empty if the text range is contained in a text table cell.

Normally, I can select multiple pieces of text. When I select one or more cells in a text table, however, I can have only one selection and the returned current selection is a TextTableCursor. The following macro illustrates these possibilities.

Listing 7.2: Does the current selection contain a text table?

Sub IsACellSelected

Dim oSels 'All of the selections

Dim oSel 'A single selection

Dim i As Integer

oSels = ThisComponent.getCurrentController().getSelection()

If oSels.supportsService("com.sun.star.text.TextRanges") Then

For i=0 to oSels.getCount()-1

oSel = oSels.getByIndex(i)

If oSel.supportsService("com.sun.star.text.TextRange") Then

If ( Not IsEmpty(oSel.TextTable) ) Then Print "The text table property is NOT empty"

If ( Not IsEmpty(oSel.Cell) ) Then Print "The Cell property is NOT empty"

End If

Next

ElseIf oSels.supportsService("com.sun.star.text.TextTableCursor") Then

REM At least one entire cell is selected

Print oSels.getRangeName()

End If

End Sub

Text Cursors, What Are They?

A regular TextCursor is an invisible cursor, which is independent of the view cursor. You can have more than one at a time and you can move them around without affecting the view cursor. The view cursor is also a text cursor, that also supports the XTextViewCursor interface. There is only one view cursor and it is visible on the screen.

A TextCursor is a TextRange which can be moved within a Text object. The standard movements include goLeft, goRight, goUp, and goDown. The first parameter is an integer indicating how many characters or lines to move. The second parameter is a boolean directing the selected text range to be expanded (True) or not. The value of True is returned as long as the move occurs. If a cursor has been selecting text by moving left and you now want it to start moving right, you probably want to use oCursor.goRight(0, False) to tell the cursor to start moving right and do not select text. This will leave no text selected.

A TextCursor has both a start and an end. If the start position is the same as the end position then no text is selected and the IsCollapsed property will be true.

A TextCursor implements interfaces that allow moves and recognizing positions specific to words, sentences, and paragraphs. This can save a lot of time.

Warning	Cursor.gotoStart() and Cursor.gotoEnd() go to the start and end of the document even if the cursor is created over a range.

See Also:

http://api.openoffice.org/docs/common/ref/com/sun/star/view/XViewCursor.html
http://api.openoffice.org/docs/common/ref/com/sun/star/text/TextCursor.html

http://api.openoffice.org/docs/common/ref/com/sun/star/text/XWordCursor.html

http://api.openoffice.org/docs/common/ref/com/sun/star/text/XSentenceCursor.html

http://api.openoffice.org/docs/common/ref/com/sun/star/text/XParagraphCursor.html

http://api.openoffice.org/docs/common/ref/com/sun/star/text/TextRange.html

http://api.openoffice.org/docs/common/ref/com/sun/star/text/XTextRange.html

You can not move a cursor to a TextTable anchor.

Text content is anchored into the text. The anchor is available using the method getAnchor(). Unfortunately, text cursors are not always compatible with an anchor. The following example demonstrates methods that fail with a text table anchor.

oAnchor = oTable.getAnchor()

oCurs.gotoRange(oAnchor.getStart(), False) REM Error

oCurs = oAnchor.getText().createTextCursorByRange(oAnchor.getStart()) REM Error

oText.insertTextContent(oAnchor.getEnd(), oTable2, False) REM Error

I was recently asked how to delete an existing table and then create another table in its place. You can use a little trick and move the cursor to the table location using the current controller.

ThisComponent.getCurrentController().select(oTable)

The following macro demonstrates how to create a table and then replace it with another.

Listing 7.3: Create a text table at the location of another.

Sub Main

Dim sName$

Dim oTable

Dim oAnchor

Dim oCurs

Dim oText

oText = ThisComponent.getText()

oTable = ThisComponent.createInstance("com.sun.star.text.TextTable")

oTable.initialize(3, 3)

'oTable.setName("wow")

oCurs = ThisComponent.getCurrentController().getViewCursor()

oText.insertTextContent(oCurs, oTable, False)

oTable.setDataArray(Array(Array(1, 2, 3), Array(4, 5, 6), Array(7, 8, 9))

sName = oTable.getName()

Print "Created table named " & sName

oTable = ThisComponent.getTextTables().getByName(sName)

oAnchor = oTable.getAnchor()

REM I will now move the view cursor to the start of the document

REM so that I can demonstrate that this works.

oCurs = ThisComponent.getCurrentController().getViewCursor()

oCurs.gotoStart(False)

REM I would Love to be able to move the cursor to the anchor,

REM but I can not create a crusor based on the anchor, move to

REM the anchor, etc. So, I use a trick and let the controller

REM move the view cursor to the table.

REM Unfortunately, you can not move the cursor to the anchor...

ThisComponent.getCurrentController().select(oTable)

oTable.dispose()

oTable = ThisComponent.createInstance("com.sun.star.text.TextTable")

oTable.initialize(2, 2)

oCurs = ThisComponent.getCurrentController().getViewCursor()

oText.insertTextContent(oCurs, oTable, False)

oTable.setDataArray(Array(Array(1, 2), Array(3, 4))

sName = oTable.getName()

Print "Created table named " & sName

End Sub

You can use the idiosyncrasies of the API to move the text cursor immediately before a text table.

Listing 7.4: Move the text cursor BEFORE a text table.

Dim oTable

Dim oCurs

oTable = ThisComponent.getTextTables.getByIndex(2)

REM Move the cursor to the first row and column

ThisComponent.getCurrentController().select(oTable)

oCurs = ThisComponent.getCurrentController().getViewCursor()

oCurs.goLeft(1, False)

You can move a cursor to a Bookmark anchor.

Bookmark anchors are compatible with a regular text cusor.

Listing 7.5: Select a bookmark anchor directly.

Dim oAnchor 'Bookmark anchor

Dim oCursor 'Cursor at the left most range.

oAnchor = ThisComponent.getBookmarks().getByName("MyMark").getAnchor()

oCursor = ThisComponent.getCurrentController().getViewCursor()

oCursor.gotoRange(oAnchor, False)

You can, also compare a cursor to see if it is before or after an anchor; this fails with a TextTable anchor.

Listing 7.6: Compare the view cursor to an anchor.

Sub CompareViewCursorToAnchor()

Dim oAnchor 'Bookmark anchor

Dim oCursor 'Cursor at the left most range.

oAnchor = ThisComponent.getBookmarks().getByName("MyMark").getAnchor()

oCursor = ThisComponent.getCurrentController().getViewCursor()

If NOT EqualUNOObjects(oCursor.getText(), oAnchor.getText()) Then

Print "The view cursor and the anchor use a different text object"

Exit Sub

End If

If oCursor.getText().compareRegionStarts(oCursor.getEnd(), oAnchor.getEnd()) >= 0 Then

Print "Cursor END is Left of the anchor end"

Else

Print "Cursor END is Right of the anchor end"

End If

End Sub

You need to experiment with the different anchor types to see which play well with cursors.

Andrew's Selected Text Framework

Most problems using selected text look the same at an abstract level.

If nothing is selected then

do work on entire document

else

for each selected area

do work on selected area

The difficult part that will change each time is writing a worker macro that will iterate over a selection or between two cursors.

Is Text Selected?

The documentations states that if there is no current controller, then getCurrentSelection() will return a null rather than the selections. I have a limited understanding of this but I will take them at their word and check for this.

If the selection count is zero, then nothing is selected. I have never seen a selection count of zero, but I check for it anyway. If no text is selected, I have one selection of zero length. I have seen examples where a zero length selection is determined as follows:

Listing 7.7: This is a problem if more than 64K of text is selected.

If Len(oSel.getString()) = 0 Then nothing is selected

The problem with this is that it is possible that selected text will contain more than 64K characters and a string can not contain more than 64K characters. I consider this not safe. The better solution is to create a text cursor from the selected range and then check to see if the start and end points are the same

Listing 7.8: Oops, I used “oDoc.Text” rather than “oSel.Text”.

oCursor = oDoc.Text.CreateTextCursorByRange(oSel)

If oCursor.IsCollapsed() Then nothing is selected

Here is the function that will perform the entire check. The code in Listing 7.8 uses the text object from the document. If the selection is not in the document's primary text object then this will fail. Listing 7.9 obtains the text object from the selection object, which is safer.

Listing 7.9: Is the cursor in a text table?

Function IsAnythingSelected(oDoc As Object) As Boolean

Dim oSelections 'All of the selections

Dim oSel 'A single selection

Dim oCursor 'A temporary cursor

IsAnythingSelected = False

If IsNull(oDoc) Then Exit Function

' The current selection in the current controller.

'If there is no current controller, it returns NULL.

oSelections = oDoc.getCurrentSelection()

If IsNull(oSelections) Then Exit Function

REM I have never seen a selection count of zero

If oSelections.getCount() = 0 Then Exit Function

REM If there are multiple selections, then certainly something is selected

If oSelections.getCount() > 1 Then

IsAnythingSelected = True

Else

REM If only one thing is selected, however, then check to see if the

REM selection is collapsed. In other words, see if the end location is

REM the same as the starting location.

REM Notice that I use the text object from the selection object

REM because it is safer than assuming that it is the same as the

REM documents text object.

oSel = oSelections.getByIndex(0)

oCursor = oSel.getText().CreateTextCursorByRange(oSel)

If Not oCursor.IsCollapsed() Then IsAnythingSelected = True

End If

End Function

How To Get A Selection

Obtaining a selection is complicated because it is possible to have multiple non-contiguous selections. Some selections are empty and some are not. Code written to handle text selection should handle all of these cases. The following example iterates through all of the selected sections printing them.

Listing 7.10: It is possible to have multiple simultaneous selections.

'******************************************************************

'Author: Andrew Pitonyak

'email: andrew@pitonyak.org

Sub MultipleTextSelectionExample

Dim oSelections As Object, oSel As Object

Dim lSelCount As Long, lWhichSelection As Long

' The current selection in the current controller.

'If there is no current controller, it returns NULL.

oSelections = ThisComponent.getCurrentSelection()

If Not IsNull(oSelections) Then

lSelCount = oSelections.getCount()

For lWhichSelection = 0 To lSelCount - 1

oSel = oSelections.getByIndex(lWhichSelection)

MsgBox oSel.getString()

Next

End If

End Sub

See Also:

http://api.openoffice.org/docs/common/ref/com/sun/star/text/XTextRange.html

Selected Text, Which End Is Which

Selections are essentially text ranges with a start and an end. Although selections have both a start and an end, which side of the text is which is determined by the selection method. The text object provides methods to compare starting and ending positions of text ranges. The method “short compareRegionStarts (XTextRange R1, XTextRange R2)” returns 1 if R1 starts before R2 , 0 if R1 starts at the same position as R2 and -1 if R1 starts after R2. The method “short compareRegionEnds (XTextRange R1, XTextRange R2)” returns 1, if R1 ends before R2 , 0, if R1 ends at the same position as R2 and -1, if R1 ends behind R2. I use the following two methods to find the leftmost and rightmost cursor position of selected text.

Listing 7.11: Determine if the start or end comes first.

'******************************************************************

'Author: Andrew Pitonyak

'email: andrew@pitonyak.org

'oSel is a text selection or cursor range

Function GetLeftMostCursor(oSel As Object) As Object

Dim oRange 'Left most range.

Dim oCursor 'Cursor at the left most range.

If oSel.getText().compareRegionStarts(oSel.getEnd(), oSel) >= 0 Then

oRange = oSel.getEnd()

Else

oRange = oSel.getStart()

End If

oCursor = oSel.getText().CreateTextCursorByRange(oRange)

oCursor.goRight(0, False)

GetLeftMostCursor = oCursor

End Function

'******************************************************************

'Author: Andrew Pitonyak

'email: andrew@pitonyak.org

'oSel is a text selection or cursor range

Function GetRightMostCursor(oSel As Object) As Object

Dim oRange 'Right most range.

Dim oCursor 'Cursor at the right most range.

If oSel.getText().compareRegionStarts(oSel.getEnd(), oSel) >= 0 Then

oRange = oSel.getStart()

Else

oRange = oSel.getEnd()

End If

oCursor = oSel.getText().CreateTextCursorByRange(oRange)

oCursor.goLeft(0, False)

GetRightMostCursor = oCursor

End Function

Tip	I modified these sections to obtain the text object from the selection objects rather than using the document's text object.

See Also:

http://api.openoffice.org/docs/common/ref/com/sun/star/text/XTextCursor.html
http://api.openoffice.org/docs/common/ref/com/sun/star/text/XSimpleText.html
http://api.openoffice.org/docs/common/ref/com/sun/star/text/XTextRangeCompare.html

The Selected Text Framework Macro

It took me a long time to understand how to iterate over selected text using cursors so I have written many macros that do things in what I consider the wrong way. I now use a high level framework to do this. The idea is that if no text is selected, then it asks if the macro should be run against the entire document. If the answer is yes, then a cursor is created at the start and the end of the document and then the worker macro is called. If text is selected, then each selection is retrieved, a cursor is obtained at the start and end of selection, and then the worker macro is called for each of these selections.

The Rejected Framework

I ultimately rejected the framework that follows because it is just too long and cumbersome to repeat every time that I wanted to iterate over text. It is, however, tenable. You may prefer this framework and choose to use it.

Listing 7.12: A cumbersome selected text framework that works.

Sub IterateOverSelectedTextFramework

Dim oSelections As Object, oSel As Object, oText As Object

Dim lSelCount As Long, lWhichSelection As Long

Dim oLCurs As Object, oRCurs As Object

oText = ThisComponent.Text

If Not IsAnythingSelected(ThisComponent) Then

Dim i%

i% = MsgBox("No text selected!" + Chr(13) + _

"Call worker for the ENTIRE document?", _

1 OR 32 OR 256, "Warning")

If i% <> 1 Then Exit Sub

oLCurs = oText.createTextCursor()

oLCurs.gotoStart(False)

oRCurs = oText.createTextCursor()

oRCurs.gotoEnd(False)

CallYourWorkerMacroHere(oLCurs, oRCurs, oText)

Else

oSelections = ThisComponent.getCurrentSelection()

lSelCount = oSelections.getCount()

For lWhichSelection = 0 To lSelCount - 1

oSel = oSelections.getByIndex(lWhichSelection)

'If I want to know if NO text is selected, I could

'do the following:

'oLCurs = oText.CreateTextCursorByRange(oSel)

'If oLCurs.isCollapsed() Then ...

oLCurs = GetLeftMostCursor(oSel, oText)

oRCurs = GetRightMostCursor(oSel, oText)

CallYourWorkerMacroHere(oLCurs, oRCurs, oText)

Next

End If

End Sub

The Accepted Framework

I opted to create the framework that follows. It returns a two dimensional array of start and end cursors over which to iterate. It allows for a very minimal code base to be used to iterate over selected text or the entire document.

Listing 7.13: Create cursors around the selected ranges.

'******************************************************************

'Author: Andrew Pitonyak

'email: andrew@pitonyak.org

'sPrompt : how to ask if should iterate over the entire text

'oCursors() : Has the return cursors

'Returns true if should iterate and false if should not

Function CreateSelectedTextIterator(oDoc As Object, sPrompt As String, oCursors()) As Boolean

Dim lSelCount As Long 'Number of selected sections.

Dim lWhichSelection As Long 'Current selection item.

Dim oSelections 'All of the selections

Dim oSel 'A single selection.

Dim oLCurs 'Cursor to the left of the current selection.

Dim oRCurs 'Cursor to the right of the current selection.

CreateSelectedTextIterator = True

If Not IsAnythingSelected(ThisComponent) Then

Dim i%

i% = MsgBox("No text selected!" + Chr(13) + sPrompt, _

1 OR 32 OR 256, "Warning")

If i% = 1 Then

oLCurs = oDoc.getText().createTextCursor()

oLCurs.gotoStart(False)

oRCurs = oDoc.getText().createTextCursor()

oRCurs.gotoEnd(False)

oCursors = DimArray(0, 1)

oCursors(0, 0) = oLCurs

oCursors(0, 1) = oRCurs

Else

oCursors = DimArray()

CreateSelectedTextIterator = False

End If

Else

oSelections = ThisComponent.getCurrentSelection()

lSelCount = oSelections.getCount()

oCursors = DimArray(lSelCount - 1, 1)

For lWhichSelection = 0 To lSelCount - 1

oSel = oSelections.getByIndex(lWhichSelection)

REM If I want to know if NO text is selected, I could

REM do the following:

REM oLCurs = oSel.getText().CreateTextCursorByRange(oSel)

REM If oLCurs.isCollapsed() Then ...

oLCurs = GetLeftMostCursor(oSel)

oRCurs = GetRightMostCursor(oSel)

oCursors(lWhichSelection, 0) = oLCurs

oCursors(lWhichSelection, 1) = oRCurs

Next

End If

End Function

The Main Worker

This is an example that then calls a worker routine.

Listing 7.14: Call the routine PrintEachCharacterWorker for each selected range.

Sub PrintExample

Dim oCursors(), i%

If Not CreateSelectedTextIterator(ThisComponent, _

"Print characters for the entire document?", oCursors()) Then Exit Sub

For i% = LBound(oCursors()) To UBound(oCursors())

PrintEachCharacterWorker(oCursors(i%, 0), oCursors(i%, 1))

Next i%

End Sub

Sub PrintEachCharacterWorker(oLCurs As Object, oRCurs As Object)

Dim oText

oText = oLCurs.getText()

If IsNull(oLCurs) Or IsNull(oRCurs) Or IsNull(oText) Then Exit Sub

If oText.compareRegionEnds(oLCurs, oRCurs) <= 0 Then Exit Sub

oLCurs.goRight(0, False)

Do While oLCurs.goRight(1, True) AND oText.compareRegionEnds(oLCurs, oRCurs) >= 0

Print "Character = '" & oLCurs.getString() & "'"

REM This will cause the currently selected text to become

REM no longer selected

oLCurs.goRight(0, False)

Loop

End Sub

Counting Sentences

I threw this together quickly and with little thought. Use at your own risk! I found some bugs in the sentence cursor while writing my book, check my Macro book page 286 for more information.

Listing 7.15: Count sentences using a sentence cursor.

REM This will most likely fail if there are any tables and such because the

REM Sentence cursor will not be able to enter the table, but I have not checked

REM this to verify.

Sub CountSentences

Dim oCursor 'A text cursor.

Dim oSentenceCursor 'A text cursor.

Dim oText

Dim i

oText = ThisComponent.Text

oCursor = oText.CreateTextCursor()

oSentenceCursor = oText.CreateTextCursor()

'Move the cursor to the start of the document

oCursor.GoToStart(False)

Do While oCursor.gotoNextParagraph(True)

'At this point, you have the entire paragraph highlighted

oSentenceCursor.gotoRange(oCursor.getStart(), False)

Do While oSentenceCursor.gotoNextSentence(True) AND_

oText.compareRegionEnds(oSentenceCursor, oCursor) >= 0

oSentenceCursor.goRight(0, False)

i = i + 1

Loop

oCursor.goRight(0, False)

Loop

MsgBox i, 0, "Number of Sentences"

End Sub

Remove Empty Spaces And Lines, A Larger Example

This set of macros replaces all runs of white space characters with a single white space character. It is easily modifiable to delete different types of white space. The different types of spaces are ordered by importance so if you have a regular space followed by a new paragraph, the new paragraph will stay and the single space will be removed. This will cause leading and trailing white space to be removed from a line.

Define “White Space”

In solving this problem, my first task was to determine what characters are white space characters. You can trivially change the definition of white space to ignore certain characters.

'Usually, this is done with an array lookup which would probably be

'faster, but I do not know how to use static initializers in .

Function IsWhiteSpace(iChar As Integer) As Boolean

Select Case iChar

Case 9, 10, 13, 32, 160

IsWhiteSpace = True

Case Else

IsWhiteSpace = False

End Select

End Function

Rank Characters For Deletion

Next, I needed to define what to remove and what to leave. I opted to do this with the following routine.

'-1 means delete the previous character

' 0 means ignore this character

' 1 means delete this character

' Rank from highest to lowest is: 0, 13, 10, 9, 160, 32

Function RankChar(iPrevChar, iCurChar) As Integer

If Not IsWhiteSpace(iCurChar) Then 'The current char is not white space, ignore it

RankChar = 0

ElseIf iPrevChar = 0 Then 'Start of a line and current char is white space

RankChar = 1 'so delete the current character.

ElseIf Not IsWhiteSpace(iPrevChar) Then 'Current char is white space but previous is not

RankChar = 0 'so ignore the current charcter.

ElseIf iPrevChar = 13 Then 'Previous char is highest ranked white space

RankChar = 1 'so delete the current character.

ElseIf iCurChar = 13 Then 'Current character is highest ranked white space

RankChar = -1 'so delete the previous character.

ElseIf iPrevChar = 10 Then 'No new Pars so see if previous char is new line

RankChar = 1 'so delete the current character.

ElseIf iCurChar = 10 Then 'No new Pars so see if the current char is new line

RankChar = -1 'so delete the previous character.

ElseIf iPrevChar = 9 Then 'No new Lines so see if the previous char is tab

RankChar = 1 'so delete the current character.

ElseIf iCurChar = 9 Then 'No new Lines so see if the current char is a tab

RankChar = -1 'so delete the previous character.

ElseIf iPrevChar = 160 Then 'No Tabs so check previous char for a hard space

RankChar = 1 'so delete the current character.

ElseIf iCurChar = 160 Then 'No Tabs so check current char for a hard space

RankChar = -1 'so delete the previous character.

ElseIf iPrevChar = 32 Then 'No hard spaces so check previous for a space

RankChar = 1 'so delete the current character.

ElseIf iCurChar = 32 Then 'No hard spaces so check current for a space

RankChar = -1 'so delete the previous character.

Else 'Should probably not get here

RankChar = 0 'so simply ignore it!

End If

End Function

The Standard Selected Text Iterator

This is the standard format to decide if work should be done on the entire document or just a portion.

Listing 7.16: Remove runs of white space.

'Remove all runs of empty space!

'If text is selected, then it will only be removed from the selected region.

Sub RemoveEmptySpace

Dim oCursors(), i%

If Not CreateSelectedTextIterator(ThisComponent, _

"ALL empty space will be removed from the ENTIRE document?", oCursors()) Then Exit Sub

For i% = LBOUND(oCursors()) To UBOUND(oCursors())

RemoveEmptySpaceWorker (oCursors(i%, 0), oCursors(i%, 1))

Next i%

End Sub

The Worker Macro

This is where the real work happens.

Listing 7.17: Enumerate across the cursors and remove white space.

Sub RemoveEmptySpaceWorker(oLCurs As Object, oRCurs As Object)

Dim sParText As String, i As Integer

Dim oText

oText = oLCurs.getText()

If IsNull(oLCurs) Or IsNull(oRCurs) Or IsNull(oText) Then Exit Sub

If oText.compareRegionEnds(oLCurs, oRCurs) <= 0 Then Exit Sub

Dim iLastChar As Integer, iThisChar As Integer, iRank As Integer

iLastChar = 0

iThisChar = 0

oLCurs.goRight(0, False)

Do While oLCurs.goRight(1, True)

iThisChar = Asc(oLCurs.getString())

i = oText.compareRegionEnds(oLCurs, oRCurs)

'If at the last character!

'Then always remove white space

If i = 0 Then

If IsWhiteSpace(iThisChar) Then oLCurs.setString("")

Exit Do

End If

'If went past the end then get out

If i < 0 Then Exit Do

iRank = RankChar(iLastChar, iThisChar)

If iRank = 1 Then

'I am about to delete this character.

'I do not change iLastChar because it did not change!

'Print "Deleting Current with " + iLastChar + " and " + iThisChar

oLCurs.setString("")

ElseIf iRank = -1 Then

'This will deselect the selected character and then select one

'more to the left.

oLCurs.goLeft(2, True)

'Print "Deleting to the left with " + iLastChar + " and " + iThisChar

oLCurs.setString("")

oLCurs.goRight(1, False)

iLastChar = iThisChar

Else

oLCurs.goRight(0, False)

iLastChar = iThisChar

End If

Loop

End Sub

Removing Empty Paragraphs, Yet Another Example

It is better to set up “AutoFormat” to remove blank paragraphs, then apply it to the document in question. Click on “Tools=>AutoCorrect/AutoFormat...” and then choose the “Options” tab. One of the options is “Remove Blank Paragraphs.” Make certain that this is checked. Now, you can auto format the document and all of the empty paragraphs are gone.

If you only want to remove selected empty paragraphs, then you will need to use a macro. If text is selected, then the empty paragraphs are removed from within the selected text. If no text is selected, then text is removed from the entire document. This first macro iterates through all of the selected text. If no text is selected, it creates a cursor at the beginning and the end of the document and then works on the entire document. The primary thing to see in this macro is how to traverse the text based on paragraphs. The removing empty space macro is the safer macro because it does not extract a string to work.

Listing 7.18: Remove empty paragraphs.

Sub RemoveEmptyParsWorker(oLCurs As Object, oRCurs As Object)

Dim sParText As String, i As Integer

Dim oText

oText = oLCurs

If IsNull(oLCurs) Or IsNull(oRCurs) Or IsNull(oText) Then Exit Sub

If oText.compareRegionEnds(oLCurs, oRCurs) <= 0 Then Exit Sub

oLCurs.goRight(0, False)

Do While oLCurs.gotoNextParagraph(TRUE) AND oText.compareRegionEnds(oLCurs, oRCurs) > 0

'Yes, I know, limited to 64K here

'If we have one paragraph that is over 64K

'Then I am in trouble!

sParText = oLCurs.getString()

i = Len(sParText)

'We do not have short circuit logical. Drat!

Do While i > 0

If (Mid(sParText,i,1) = Chr(10)) OR (Mid(sParText,i,1) = Chr(13)) Then

i = i - 1

Else

i = -1

End If

Loop

If i = 0 Then

oLCurs.setString("")

Else

oLCurs.goLeft(0,FALSE)

End If

loop

End Sub

Selected Text, Timing Considerations And Counting Words

Anyone who has studied algorithms will tell you that a better algorithm is usually better than a faster computer. When I first wrote the macros that manipulate blank lines and spaces, I wrote them using strings. This introduced the possibility of losing formatting information and failure when the strings exceeded 64K in size. I then wrote the macros using cursors and I received complaints that they were too slow. The question arises, is there a better way?

Searching Selected Text To Count Words

Andrew Brown, the maintainer of http://www.darwinwars.com (contains useful macro information), asked about performing searches inside of a selected region. ??See the section on searching selected text.??

I found out that this was used to count words in a document and that it was very slow; too slow.

Using Strings To Count Words

The existing code counted the number of spaces in the selected region and used that to determine the number of words. I then wrote my own version that was a bit more general, slightly faster, and produced the correct answer.

Listing 7.19: Count words in a safe but slow way.

Function ADPWordCountStrings(vDoc) As String

REM Place what ever characters you want as word separators here!

Dim sSeps$

sSeps = Chr$(9) & Chr$(13) & Chr$(10) & " ,;."

Dim bSeps(256) As Boolean, i As Long

For i = LBound(bSeps()) To UBound(bSeps())

bSeps(i) = False

Next

For i = 1 To Len(sSeps)

bSeps(Asc(Mid(sSeps, i, 1))) = True

Next

Dim nSelChars As Long, nSelwords As Long, nSel%, nNonEmptySel%, j As Long, s$

Dim vSelections, vSel, oText, oCursor

' The current selection in the current controller.

'If there is no current controller, it returns NULL.

vSelections = vDoc.getCurrentSelection()

If IsNull(vSelections) Then

nSel = 0

Else

nSel = vSelections.getCount()

End If

nNonEmptySel = 0

Dim lTemp As Long, bBetweenWords As Boolean, bIsSep As Boolean

On Local Error Goto BadOutOfRange

Do While nSel > 0

nSel = nSel - 1

s = vSelections.GetByIndex(nSel).getString()

REM See if this is an empty selection

lTemp = Len(s)

If lTemp > 0 Then

nSelChars = nSelChars + lTemp

nNonEmptySel = nNonEmptySel + 1

REM Does this start on a word?

If bSeps(Asc(Mid(s, 1, 1))) Then

bBetweenWords = True

Else

bBetweenWords = False

nSelWords = nSelWords + 1

End If

For j = 2 To lTemp

bIsSep = bSeps(Asc(Mid(s, j, 1)))

If bBetweenWords <> bIsSep Then

If bBetweenWords Then

REM Only count a new word if I was between words

REM and I am no longer between words!

bBetweenWords = False

nSelWords = nSelWords + 1

Else

bBetweenWords = True

End If

End If

Next

End If

Loop

On Local Error Goto 0

Dim nAllChars As Long, nAllWords As Long, nAllPars As Long

' access document statistics

nAllChars = vDoc.CharacterCount

nAllWords = vDoc.WordCount

nAllPars = vDoc.ParagraphCount

Dim sRes$

sRes = "Document count:" & chr(13) & nAllWords & " words. " &_

chr(13) & "(" & nAllChars & " Chars." & chr(13) & nAllPars &_

" Paragraphs.)" & chr(13) & chr(13)

If nNonEmptySel > 0 Then

sRes = sRes & "Selected text count:" & chr(13) & nSelWords &_

" words" & chr(13) & "(" & nSelChars & " chars)" &_

chr(13) & "In " & str(nNonEmptySel) & " selection"

If nNonEmptySel > 1 Then sRes = sRes & "s"

sRes=sRes & "." & chr(13) & chr(13) & "Document minus selected:" &_

chr(13)& str(nAllWords-nSelWords) & " words."

End If

'MsgBox(sRes,64,"ADP Word Count")

ADPWordCountStrings = sRes

Exit Function

BadOutOfRange:

bIsSep = False

Resume Next

End Function

Each selected range is extracted as a string. This fails if the selected text is greater than 64K in size. The ASCII value of each character is checked to see if it is considered a word separator. This is done by an array lookup. This was efficient but failed if there was a special character that had an ASCII value larger than the array so an error handling routine is used. Special handling is done so that the correct values are obtained with various selections. This took about 2.7 seconds to check 8000 words.

Using A Character Cursor To Count Words

In an attempt to avoid the 64K limit, I wrote a version the used cursors to traverse the text one character at a time. This version took 47 seconds to check the same 8000 words. This uses the same algorithm as the string method, but the overhead of using a cursor to find each character is prohibitive.

Listing 7.20: Count words using a character cursor.

'******************************************************************

'Author: Andrew Pitonyak

'email: andrew@pitonyak.org

Function ADPWordCountCharCursor(vDoc) As String

Dim oCursors(), i%, lNumWords As Long

lNumWords = 0

If Not CreateSelectedTextIterator(vDoc, _

"Count Words in the entire document?", oCursors()) Then Exit Function

For i% = LBound(oCursors()) To UBound(oCursors())

lNumWords = lNumWords + WordCountCharCursor(oCursors(i%, 0), oCursors(i%, 1), vDoc.Text)

Next

ADPWordCountCharCursor = "Total Words = " & lNumWords

End Function

'******************************************************************

'Author: Andrew Pitonyak

'email: andrew@pitonyak.org

Function WordCountCharCursor(oLCurs, oRCurs, oText)

Dim lNumWords As Long

lNumWords = 0

WordCountCharCursor = lNumWords

If IsNull(oLCurs) Or IsNull(oRCurs) Or IsNull(oText) Then Exit Function

If oText.compareRegionEnds(oLCurs, oRCurs) <= 0 Then Exit Function

Dim sSeps$

sSeps = Chr$(9) & Chr$(13) & Chr$(10) & " ,;."

Dim bSeps(256) As Boolean, i As Long

For i = LBound(bSeps()) To UBound(bSeps())

bSeps(i) = False

Next

For i = 1 To Len(sSeps)

bSeps(Asc(Mid(sSeps, i, 1))) = True

Next

On Local Error Goto BadOutOfRange

Dim bBetweenWords As Boolean, bIsSep As Boolean

oLCurs.goRight(0, False)

oLCurs.goRight(1, True)

REM Does this start on a word?

If bSeps(Asc(oLCurs.getString())) Then

bBetweenWords = True

Else

bBetweenWords = False

lNumWords = lNumWords + 1

End If

oLCurs.goRight(0, False)

Do While oLCurs.goRight(1, True) AND oText.compareRegionEnds(oLCurs, oRCurs) >= 0

bIsSep = bSeps(Asc(oLCurs.getString()))

If bBetweenWords <> bIsSep Then

If bBetweenWords Then

REM Only count a new word if I was between words

REM and I am no longer between words!

bBetweenWords = False

lNumWords = lNumWords + 1

Else

bBetweenWords = True

End If

End If

oLCurs.goRight(0, False)

Loop

WordCountCharCursor = lNumWords

Exit Function

BadOutOfRange:

bIsSep = False

Resume Next

End Function

Using A Word Cursor To Count Words

This is the fastest method yet. This uses a word cursor and lets OOo figure out where words start and end. This will check the 8000 words in 1.7 seconds. This macro moves from word to word counting how many word breaks it finds. Because of this, the result may be off by one. I found bugs with word cursors while writing my book.

Listing 7.21: count words using a word cursor.

'******************************************************************

'Author: Andrew Pitonyak

'email: andrew@pitonyak.org

Function ADPWordCountWordCursor(vDoc) As String

Dim oCursors(), i%, lNumWords As Long

lNumWords = 0

If Not CreateSelectedTextIterator(vDoc, _

"Count Words in the entire document?", oCursors()) Then Exit Function

For i% = LBound(oCursors()) To UBound(oCursors())

lNumWords = lNumWords + WordCountWordCursor(oCursors(i%, 0), oCursors(i%, 1), vDoc.Text)

Next

ADPWordCountWordCursor = "Total Words = " & lNumWords

End Function

'******************************************************************

'Author: Andrew Pitonyak

'email: andrew@pitonyak.org

Function WordCountWordCursor(oLCurs, oRCurs, oText)

Dim lNumWords As Long

lNumWords = 0

WordCountWordCursor = lNumWords

If IsNull(oLCurs) Or IsNull(oRCurs) Or IsNull(oText) Then Exit Function

If oText.compareRegionEnds(oLCurs, oRCurs) <= 0 Then Exit Function

oLCurs.goRight(0, False)

Do While oLCurs.gotoNextWord(False) AND oText.compareRegionEnds(oLCurs, oRCurs) >= 0

lNumWords = lNumWords + 1

Loop

WordCountWordCursor = lNumWords

End Function

Final Thoughts On Counting Words And Timing

If your solution to a problem is too slow, then perhaps there is another way. In OOo, cursors can move based on characters, words, or paragraphs. The cursor that you use makes a significant difference in the runtime.

If you want to count the number of words in a selected region, I recommend that you take a look at Andrew Brown's website, http://www.darwinwars.com, because he is actively working on counting words. In fact, he has provided a macro that I consider the correct way to do it... See the next section.

Counting Words, You Should Use This Macro!

The following macro was sent to me by Andrew Brown, as already mentioned. You really should check his web site, it has a lot of very nice things; and in case you missed it, he wrote a book. It is not about macro programming, but I really enjoyed parts of it. Check it out!

Listing 7.22: Count words safely.

Sub acbwc

' v2.0.1

' 5 sept 2003

' does footnotes and selections of all sizes

' still slow with large selections, but I blame Hamburg :-)

' v 2.0.1 slightly faster with improved cursorcount routine

' not unendurably slow with lots of footnotes, using cursors.

' acb, June 2003

' rewritten version of the

' dvwc macro by me and Daniel Vogelheim

' september 2003 changed the selection count to use a word cursor for large selections

' following hints from Andrew Pitonyak.

' this is not perfect, either, largely because move-by-word is erratic.

' it will slightly exaggerate the number of words in a selection, counting extra

' for paragraph ends and some punctuation.

' but it is still much quicker than the old method.

Dim xDoc, xSel, nSelcount

Dim nAllChars

Dim nAllWords

Dim nAllPars

Dim thisrange, sRes

Dim nSelChars, nSelwords, nSel

Dim atext, bigtext

Dim fnotes, thisnote, nfnotes, fnotecount

Dim oddthing,startcursor,stopcursor

xDoc = thiscomponent

xSel = xDoc.getCurrentSelection()

nSelCount = xSel.getCount()

bigText=xDoc.getText()

' by popular demand ...

fnotes=xdoc.getFootNotes()

If fnotes.hasElements() Then

fnotecount=0

For nfnotes=0 To fnotes.getCount()-1

thisnote=fnotes.getbyIndex(nfnotes)

startcursor=thisnote.getStart()

stopcursor=thisnote.getEnd()

Do While thisnote.getText().compareRegionStarts(startcursor,stopcursor) AND _

startcursor.gotoNextWord(FALSE)

fnotecount=fnotecount+1

Loop

' msgbox(startcursor.getString())

' fnotecount=fnotecount+stringcount(thisnote.getstring())

' fnotecount=fnotecount+CursorCount(thisnote,bigtext)

Next nfnotes

End If

' this next "If" works around the problem that If you have made a selection, then

' collapse it, and count again, the empty selection is still counted,

' which was confusing and ugly

If nSelCount=1 and xSel.getByIndex(0).getString()="" Then

nSelCount=0

End If

' access document statistics

nAllChars = xDoc.CharacterCount

nAllWords = xDoc.WordCount

nAllPars = xDoc.ParagraphCount

' initialize counts

nSelChars = 0

nSelWords = 0

' the fancy bit starts here

' iterate over multiple selection

For nSel = 0 To nSelCount - 1

thisrange=xSel.GetByIndex(nSel)

atext=thisrange.getString()

If len(atext)< 220 Then

nselwords=nSelWords+stringcount(atext)

Else

nselwords=nSelWords+Cursorcount(thisrange)

End If

nSelChars=nSelChars+len(atext)

Next nSel

' dialog code rewritten for legibility

If fnotes.hasElements() Then

sRes="Document count (with footnotes): " + nAllWords + " words. " + chr(13)

sRes= sRes + "Word count without footnotes: " + str(nAllWords-fnotecount) +_

" words. " + chr(13)+"(Total: " +nAllChars +" Chars in "

Else

sRes= "Document count: " + nAllWords +" words. " + chr(13)+"(" + _

nAllChars +" Chars in "

End If

sRes=sRes + nAllPars +" Paragraphs.)"+ chr(13)+ chr(13)

If nselCount>0 Then

sRes=sRes + "Selected text count: " + nSelWords + " words" + chr(13) +_

"(" + nSelChars + " chars"

If nSelcount=1 Then

sRes=sRes + " In " + str(nselCount) + " selection.)"

Else

REM I don't know why, but need this adjustment

sRes=sRes + " In " + str(nselCount-1) +" selections.)"

End If

sRes=sRes+chr(13)+chr(13)+"Document minus selected:" + chr(13)+_

str(nAllWords-nSelWords) + " words." +chr(13) +chr(13)

End If

If fnotes.hasElements() Then

sRes=sRes+"There are "+ str(fnotecount) + " words in "+ fnotes.getCount() +_

" footnotes." +chr(13) +chr(13)

End If

msgbox(sRes,64,"acb Word Count")

End Sub

function Cursorcount(aRange)

' acb September 2003

' quick count for use with large selections

' based on Andrew Pitonyak's WordCountWordCursor() function

' but made cruder, in line with my general tendency.

Dim lnumwords as long

Dim atext

Dim startcursor, stopcursor as object

atext=arange.getText()

lnumwords=0

If not atext.compareRegionStarts(aRange.getStart(),aRange.getEnd()) Then

startcursor=atext.createTextCursorByRange(aRange.getStart())

stopcursor=atext.createTextCursorByRange(aRange.getEnd())

Else

startcursor=atext.createTextCursorByRange(aRange.getEnd())

stopcursor=atext.createTextCursorByRange(aRange.getStart())

End If

Do while aText.compareRegionEnds(startCursor, stopcursor) >= 0 and _

startCursor.gotoNextWord(False)

lnumwords=lnumwords+1

Loop

CursorCount=lnumwords-1

end function

Function stringcount(astring)

' acb June 2003

' slower, more accurate word count

' for use with smaller strings

' sharpened up by David Hammerton (http://crazney.net/) in September 2003

' to allow those who put two spaces after punctuation to escape their just deserts

Dim nspaces,i,testchar,nextchar

nspaces=0

For i= 1 To len(astring)-1

testchar=mid(astring,i,1)

select Case testchar

Case " ",chr(9),chr(13)

nextchar = mid(astring,i+1,1)

select Case nextchar

Case " ",chr(9),chr(13),chr(10)

nspaces=nspaces

Case Else

nspaces=nspaces+1

end select

end select

Next i

stringcount=nspaces+1

End Function

Replacing Selected Space Using Strings

In general, you should not remove extra space by reading the selected text and then writing new values back. One reason is that strings are limited to 64K in size, and the other is that it is possible to lose formatting information. I left these examples in place because they work for the problems they were written to solve before I learned how I could do the same thing with cursors, and because they demonstrate techniques of inserting special characters. This first macro replaces all new paragraphs and new lines with a space character. These are also the examples that demonstrate how to insert control characters (new paragraphs, line breaks, etc.) into the text.

Listing 7.23: Modify the text in an unsafe way.

Sub SelectedNewLinesToSpaces

Dim lSelCount&, oSelections As Object

Dim iWhichSelection As Integer, lIndex As Long

Dim s$, bSomethingChanged As Boolean

oSelections = ThisComponent.getCurrentSelection()

lSelCount = oSelections.getCount()

For iWhichSelection = 0 To lSelCount - 1

bSomethingChanged = False

REM What If the string is bigger than 64K? Oops

s = oSelections.getByIndex(iWhichSelection).getString()

lIndex = 1

Do While lIndex < Len(s)

Select Case Asc(Mid(s, lIndex, 1))

Case 13

'We found a new paragraph marker.

'The next character will be a 10!

If lIndex < Len(s) AND Asc(Mid(s, lIndex+1, 1)) = 10 Then

Mid(s, lIndex, 2, " ")

Else

Mid(s, lIndex, 1, " ")

End If

lIndex = lIndex + 1

bSomethingChanged = True

Case 10

'New line unless the previous charcter is a 13

'Remove this entire case statement to ignore only new lines!

If lIndex > 1 AND Asc(Mid(s, lIndex-1, 1)) <> 13 Then

'This really is a new line and NOT a new paragraph.

Mid(s, lIndex, 1, " ")

lIndex = lIndex + 1

bSomethingChanged = True

Else

'Nope, this one really was a new paragraph!

lIndex = lIndex + 1

End If

Case Else

'Do nothing If we do not match something else

lIndex = lIndex + 1

End Select

Loop

If bSomethingChanged Then

oSelections.getByIndex(iWhichSelection).setString(s)

End If

Next

End Sub

I was also asked to convert new paragraphs to new lines. Using cursors is clearly a better idea, but I did not know how to do it. I think that this example is still instructive, so I left it in. I first delete the selected text and then start adding the text back.

Listing 7.24: Use text cursors to replace space.

Sub SelectedNewParagraphsToNewLines

Dim lSelCount&, oSelections As Object, oSelection As Object

Dim iWhichSelection As Integer, lIndex As Long

Dim oText As Object, oCursor As Object

Dim s$, lLastCR As Long, lLastNL As Long

oSelections = ThisComponent.getCurrentSelection()

lSelCount = oSelections.getCount()

oText=ThisComponent.Text

For iWhichSelection = 0 To lSelCount - 1

oSelection = oSelections.getByIndex(iWhichSelection)

oCursor=oText.createTextCursorByRange(oSelection)

s = oSelection.getString()

'Delete the selected text!

oCursor.setString("")

lIndex = 1

Do While lIndex <= Len(s)

Select Case Asc(Mid(s, lIndex, 1)

Case 13

oText.insertControlCharacter(oCursor, _

com.sun.star.text.ControlCharacter.LINE_BREAK, False)

'I wish I had short circuit booleans!

'Skip the next LF If there is one. I think there

'always will be but I can not verify this

If (lIndex < Len(s)) Then

If Asc(Mid(s, lIndex+1, 1)) = 10 Then lIndex = lIndex + 1

End If

Case 10

oText.insertControlCharacter(oCursor, _

com.sun.star.text.ControlCharacter.LINE_BREAK, False)

Case Else

oCursor.setString(Mid(s, lIndex, 1))

oCursor.GoRight(1, False)

End Select

lIndex = lIndex + 1

Loop

Next

End Sub

Compare Cursors And String Examples

Here are some macros that I wrote using the cursor methods and following them, the same way I had done them before I had my framework!

Listing 7.25: I wrote these a long time ago!

'******************************************************************

'Author: Andrew Pitonyak

'email: andrew@pitonyak.org

'The purpose of this macro is to make it easier to use the Text<-->Table

'method which wants trailing and leading white space removed.

'It also wants new paragraphs and NOT new lines!

Sub CRToNLMain

Dim oCursors(), i%, sPrompt$

sPrompt$ = "Convert New Paragraphs to New Lines for the ENTIRE document?"

If Not CreateSelectedTextIterator(ThisComponent, sPrompt$, oCursors()) Then Exit Sub

For i% = LBOUND(oCursors()) To UBOUND(oCursors())

CRToNLWorker(oCursors(i%, 0), oCursors(i%, 1), ThisComponent.Text)

Next i%

End Sub

Sub CRToNLWorker(oLCurs As Object, oRCurs As Object, oText As Object)

If IsNull(oLCurs) Or IsNull(oRCurs) Or IsNull(oText) Then Exit Sub

If oText.compareRegionEnds(oLCurs, oRCurs) <= 0 Then Exit Sub

oLCurs.goRight(0, False)

Do While oLCurs.gotoNextParagraph(False) AND oText.compareRegionEnds(oLCurs, oRCurs) >= 0

oLCurs.goLeft(1, True)

oLCurs.setString("")

oLCurs.goRight(0, False)

oText.insertControlCharacter(oLCurs,_

com.sun.star.text.ControlCharacter.LINE_BREAK, True)

Loop

End Sub

'******************************************************************

'Author: Andrew Pitonyak

'email: andrew@pitonyak.org

'The real purpose of this macro is to make it easier to use the Text<-->Table

'method which wants trailing and leading white space removed.

'It also wants new paragraphs and NOT new lines!

Sub SpaceToTabsInWordsMain

Dim oCursors(), i%, sPrompt$

sPrompt$ = "Convert Spaces to TABS for the ENTIRE document?"

If Not CreateSelectedTextIterator(ThisComponent, sPrompt$, oCursors()) Then Exit Sub

For i% = LBOUND(oCursors()) To UBOUND(oCursors())

SpaceToTabsInWordsWorker(oCursors(i%, 0), oCursors(i%, 1), ThisComponent.Text)

Next i%

End Sub

Sub SpaceToTabsInWordsWorker(oLCurs As Object, oRCurs As Object, oText As Object)

Dim iCurrentState As Integer, iChar As Integer, bChanged As Boolean

Const StartLineState = 0

Const InWordState = 1

Const BetweenWordState = 2

If IsNull(oLCurs) Or IsNull(oRCurs) Or IsNull(oText) Then Exit Sub

If oText.compareRegionEnds(oLCurs, oRCurs) <= 0 Then Exit Sub

oLCurs.goRight(0, False)

iCurrentState = StartLineState

bChanged = False

Do While oLCurs.goRight(1, True) AND oText.compareRegionEnds(oLCurs, oRCurs) >= 0

iChar = Asc(oLCurs.getString())

If iCurrentState = StartLineState Then

If IsWhiteSpace(iChar) Then

oLCurs.setString("")

Else

iCurrentState = InWordState

End If

ElseIf iCurrentState = InWordState Then

bChanged = True

Select Case iChar

Case 9

REM It is already a tab, ignore it

iCurrentState = BetweenWordState

Case 32, 160

REM Convert the space to a tab

oLCurs.setString(Chr(9))

oLCurs.goRight(1, False)

iCurrentState = BetweenWordState

Case 10

REM Remove the new line and insert a new paragraph

oText.insertControlCharacter(oLCurs,_

com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, True)

oLCurs.goRight(1, False)

iCurrentState = StartLineState

Case 13

iCurrentState = StartLineState

Case Else

oLCurs.gotoEndOfWord(True)

End Select

ElseIf iCurrentState = BetweenWordState Then

Select Case iChar

Case 9, 32, 160

REM We already added a tab, this is extra stuff!

oLCurs.setString("")

Case 10

REM Remove the new line and insert a new paragraph

REM and be sure to delete the leading TAB that we already

REM added in and that should come out!

oText.insertControlCharacter(oLCurs,_

com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, True)

oLCurs.goLeft(0, False)

REM and over the TAB for deletion

oLCurs.goLeft(1, True)

oLCurs.setString("")

oLCurs.goRight(1, False)

iCurrentState = StartLineState

Case 13

REM first, backup over the CR, then select the TAB and delete it

oLCurs.goLeft(0, False)

oLCurs.goLeft(1, False)

oLCurs.goLeft(1, True)

oLCurs.setString("")

REM finally, move back over the CR that we will ignore

oLCurs.goRight(1, True)

iCurrentState = StartLineState

Case Else

iCurrentState = InWordState

oLCurs.gotoEndOfWord(False)

End Select

End If

oLCurs.goRight(0, False)

Loop

If bChanged Then

REM To get here, we went one character too far right

oLCurs.goLeft(1, False)

oLCurs.goLeft(1, True)

If Asc(oLCurs.getString()) = 9 Then oLCurs.setString("")

End If

End Sub

'******************************************************************

'Author: Andrew Pitonyak

'email: andrew@pitonyak.org

Sub TabsToSpacesMain

Dim oCursors(), i%, sPrompt$

sPrompt$ = "Convert TABS to Spaces for the ENTIRE document?"

If Not CreateSelectedTextIterator(ThisComponent, sPrompt$, oCursors()) Then Exit Sub

For i% = LBOUND(oCursors()) To UBOUND(oCursors())

TabsToSpacesWorker(oCursors(i%, 0), oCursors(i%, 1), ThisComponent.Text)

Next i%

End Sub

Sub TabsToSpacesWorker(oLCurs As Object, oRCurs As Object, oText As Object)

If IsNull(oLCurs) Or IsNull(oRCurs) Or IsNull(oText) Then Exit Sub

If oText.compareRegionEnds(oLCurs, oRCurs) <= 0 Then Exit Sub

oLCurs.goRight(0, False)

Do While oLCurs.goRight(1, True) AND oText.compareRegionEnds(oLCurs, oRCurs) >= 0

If Asc(oLCurs.getString()) = 9 Then

oLCurs.setString(" ") 'Change a tab into 4 spaces

End If

oLCurs.goRight(0, False)

Loop

End Sub

'******************************************************************

'Author: Andrew Pitonyak

'email: andrew@pitonyak.org

'sPrompt : how to ask if should iterate over the entire text

'oCursors() : Has the return cursors

'Returns true if should iterate and false if should not

Function CreateSelectedTextIterator(oDoc As Object, sPrompt As String, oCursors()) As Boolean

Dim oSelections As Object, oSel As Object, oText As Object

Dim lSelCount As Long, lWhichSelection As Long

Dim oLCurs As Object, oRCurs As Object

CreateSelectedTextIterator = True

oText = oDoc.Text

If Not IsAnythingSelected(ThisComponent) Then

Dim i%

i% = MsgBox("No text selected!" + Chr(13) + sPrompt, _

1 OR 32 OR 256, "Warning")

If i% = 1 Then

oLCurs = oText.createTextCursor()

oLCurs.gotoStart(False)

oRCurs = oText.createTextCursor()

oRCurs.gotoEnd(False)

oCursors = DimArray(0, 1)

oCursors(0, 0) = oLCurs

oCursors(0, 1) = oRCurs

Else

oCursors = DimArray()

CreateSelectedTextIterator = False

End If

Else

oSelections = ThisComponent.getCurrentSelection()

lSelCount = oSelections.getCount()

oCursors = DimArray(lSelCount - 1, 1)

For lWhichSelection = 0 To lSelCount - 1

oSel = oSelections.getByIndex(lWhichSelection)

'If I want to know if NO text is selected, I could

'do the following:

'oLCurs = oText.CreateTextCursorByRange(oSel)

'If oLCurs.isCollapsed() Then ...

oLCurs = GetLeftMostCursor(oSel, oText)

oRCurs = GetRightMostCursor(oSel, oText)

oCursors(lWhichSelection, 0) = oLCurs

oCursors(lWhichSelection, 1) = oRCurs

Next

End If

End Function

'******************************************************************

'Author: Andrew Pitonyak

'email: andrew@pitonyak.org

'oDoc is a writer object

Function IsAnythingSelected(oDoc As Object) As Boolean

Dim oSelections As Object, oSel As Object, oText As Object, oCursor As Object

IsAnythingSelected = False

If IsNull(oDoc) Then Exit Function

' The current selection in the current controller.

'If there is no current controller, it returns NULL.

oSelections = oDoc.getCurrentSelection()

If IsNull(oSelections) Then Exit Function

If oSelections.getCount() = 0 Then Exit Function

If oSelections.getCount() > 1 Then

IsAnythingSelected = True

Else

oSel = oSelections.getByIndex(0)

oCursor = oDoc.Text.CreateTextCursorByRange(oSel)

If Not oCursor.IsCollapsed() Then IsAnythingSelected = True

End If

End Function

'******************************************************************

'Author: Andrew Pitonyak

'email: andrew@pitonyak.org

'oSelection is a text selection or cursor range

'oText is the text object

Function GetLeftMostCursor(oSel As Object, oText As Object) As Object

Dim oRange As Object, oCursor As Object

If oText.compareRegionStarts(oSel.getEnd(), oSel) >= 0 Then

oRange = oSel.getEnd()

Else

oRange = oSel.getStart()

End If

oCursor = oText.CreateTextCursorByRange(oRange)

oCursor.goRight(0, False)

GetLeftMostCursor = oCursor

End Function

'******************************************************************

'Author: Andrew Pitonyak

'email: andrew@pitonyak.org

'oSelection is a text selection or cursor range

'oText is the text object

Function GetRightMostCursor(oSel As Object, oText As Object) As Object

Dim oRange As Object, oCursor As Object

If oText.compareRegionStarts(oSel.getEnd(), oSel) >= 0 Then

oRange = oSel.getStart()

Else

oRange = oSel.getEnd()

End If

oCursor = oText.CreateTextCursorByRange(oRange)

oCursor.goLeft(0, False)

GetRightMostCursor = oCursor

End Function

'******************************************************************

'Author: Andrew Pitonyak

'email: andrew@pitonyak.org

'oSelection is a text selection or cursor range

'oText is the text object

Function IsWhiteSpace(iChar As Integer) As Boolean

Select Case iChar

Case 9, 10, 13, 32, 160

IsWhiteSpace = True

Case Else

IsWhiteSpace = False

End Select

End Function

'******************************************************************

'Here starts the OLD macros!

'Author: Andrew Pitonyak

Sub ConvertSelectedNewParagraphToNewLine

Dim lSelCount&, oSelections As Object, oSelection As Object

Dim iWhichSelection As Integer, lIndex As Long

Dim oText As Object, oCursor As Object

Dim s$, lLastCR As Long, lLastNL As Long

'There may be multiple selections present!

oSelections = ThisComponent.getCurrentSelection()

lSelCount = oSelections.getCount()

oText=ThisComponent.Text

For iWhichSelection = 0 To lSelCount - 1

oSelection = oSelections.getByIndex(iWhichSelection)

oCursor=oText.createTextCursorByRange(oSelection)

s = oSelection.getString()

oCursor.setString("")

lLastCR = -1

lLastNL = -1

lIndex = 1

Do While lIndex <= Len(s)

Select Case Asc(Mid(s, lIndex, 1)

Case 13

oText.insertControlCharacter(oCursor,_

com.sun.star.text.ControlCharacter.LINE_BREAK, False)

'Boy I wish I had short circuit booleans!

'Skip the next LF if there is one. I think that there

'always will be but I can not verify this

If (lIndex < Len(s)) Then

If Asc(Mid(s, lIndex+1, 1)) = 10 Then lIndex = lIndex + 1

End If

Case 10

oText.insertControlCharacter(oCursor,_

com.sun.star.text.ControlCharacter.LINE_BREAK, False)

Case Else

oCursor.setString(Mid(s, lIndex, 1))

oCursor.GoRight(1, False)

End Select

lIndex = lIndex + 1

Loop

Next

End Sub

'I decided to write this as a finite state machine

'Finite state machines are a wonderful thing :-)

Sub ConvertSelectedSpaceToTabsBetweenWords

Dim lSelCount&, oSelections As Object, oSelection As Object

Dim iWhichSelection As Integer, lIndex As Long

Dim oText As Object, oCursor As Object

Dim s$, lLastCR As Long, lLastNL As Long

REM What states are supported

Dim iCurrentState As Integer

Const StartLineState = 0

Const InWordState = 1

Const BetweenWordState = 2

REM Transition Points

Dim iWhatFound As Integer

Const FoundWhiteSpace = 0

Const FoundNewLine = 1

Const FoundOther = 2

Const ActionIgnoreChr = 0

Const ActionDeleteChr = 1

Const ActionInsertTab = 2

REM Define the state transitions

Dim iNextState(0 To 2, 0 To 2, 0 To 1) As Integer

iNextState(StartLineState, FoundWhiteSpace, 0) = StartLineState

iNextState(StartLineState, FoundNewLine, 0) = StartLineState

iNextState(StartLineState, FoundOther, 0) = InWordState

iNextState(InWordState, FoundWhiteSpace, 0) = BetweenWordState

iNextState(InWordState, FoundNewLine, 0) = StartLineState

iNextState(InWordState, FoundOther, 0) = InWordState

iNextState(BetweenWordState, FoundWhiteSpace, 0)= BetweenWordState

iNextState(BetweenWordState, FoundNewLine, 0) = StartLineState

iNextState(BetweenWordState, FoundOther, 0) = InWordState

REM Define the state actions

iNextState(StartLineState, FoundWhiteSpace, 1) = ActionDeleteChr

iNextState(StartLineState, FoundNewLine, 1) = ActionIgnoreChr

iNextState(StartLineState, FoundOther, 1) = ActionIgnoreChr

iNextState(InWordState, FoundWhiteSpace, 1) = ActionDeleteChr

iNextState(InWordState, FoundNewLine, 1) = ActionIgnoreChr

iNextState(InWordState, FoundOther, 1) = ActionIgnoreChr

iNextState(BetweenWordState, FoundWhiteSpace, 1) = ActionDeleteChr

iNextState(BetweenWordState, FoundNewLine, 1) = ActionIgnoreChr

iNextState(BetweenWordState, FoundOther, 1) = ActionInsertTab

'There may be multiple selections present!

oSelections = ThisComponent.getCurrentSelection()

lSelCount = oSelections.getCount()

oText=ThisComponent.Text

For iWhichSelection = 0 To lSelCount - 1

oSelection = oSelections.getByIndex(iWhichSelection)

oCursor=oText.createTextCursorByRange(oSelection)

s = oSelection.getString()

oCursor.setString("")

lLastCR = -1

lLastNL = -1

lIndex = 1

iCurrentState = StartLineState

Do While lIndex <= Len(s)

Select Case Asc(Mid(s, lIndex, 1))

Case 9, 32, 160

iWhatFound = FoundWhiteSpace

Case 10

iWhatFound = FoundNewLine

lLastNL = lIndex

Case 13

iWhatFound = FoundNewLine

lLastCR = lIndex

Case Else

iWhatFound = FoundOther

End Select

Select Case iNextState(iCurrentState, iWhatFound, 1)

Case ActionDeleteChr

'By choosing to not insert, it is deleted!

Case ActionIgnoreChr

'This really means that I must add the character Back!

If lLastCR = lIndex Then

'Inserting a control character seems to move the

'cursor around

oText.insertControlCharacter(oCursor,_

com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False)

' oText.insertControlCharacter(oCursor,_

' com.sun.star.text.ControlCharacter.APPEND_PARAGRAPH, False)

'oCursor.goRight(1, False)

'Print "Inserted a CR"

ElseIf lLastNL = lIndex Then

If lLastCR + 1 <> lIndex Then

oText.insertControlCharacter(oCursor,_

com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False)

'com.sun.star.text.ControlCharacter.LINE_BREAK, False)

'oCursor.goRight(1, False)

'Print "Inserted a NL"

End If

'Ignore this one

Else

oCursor.setString(Mid(s, lIndex, 1))

oCursor.GoRight(1, False)

'Print "Inserted Something"

End If

Case ActionInsertTab

oCursor.setString(Chr$(9) + Mid(s, lIndex, 1))

oCursor.GoRight(2, False)

'Print "Inserted a tab"

End Select

lIndex = lIndex + 1

'MsgBox "index = " + lIndex + Chr(13) + s

iCurrentState = iNextState(iCurrentState, iWhatFound, 0)

Loop

Next

End Sub

Sub ConvertAllTabsToSpace

DIM oCursor As Object, oText As Object

Dim nSpace%, nTab%, nPar%, nRet%, nTot%

Dim justStarting As Boolean

oText=ThisComponent.Text 'Get the Text component

oCursor=oText.createTextCursor() 'Create a cursor in the text

oCursor.gotoStart(FALSE) 'Goto the start but do NOT select the text as you go

Do While oCursor.GoRight(1, True) 'Move right one chracter and select it

If Asc(oCursor.getString()) = 9 Then

oCursor.setString(" ") 'Change a tab into 4 spaces

End If

oCursor.goRight(0,FALSE) 'Deselect text!

Loop

End Sub

Sub ConvertSelectedTabsToSpaces

Dim lSelCount&, oSelections As Object

Dim iWhichSelection As Integer, lIndex As Long

Dim s$, bSomethingChanged As Boolean

'There may be multiple selections present!

'There will probably be one more than expected because

'it will count the current cursor location as one piece

'of selected text, just so you know!

oSelections = ThisComponent.getCurrentSelection()

lSelCount = oSelections.getCount()

'Print "total selected = " + lSelCount

For iWhichSelection = 0 To lSelCount - 1

bSomethingChanged = False

s = oSelections.getByIndex(iWhichSelection).getString()

'Print "Text group " + iWhichSelection + " is of length " + Len(s)

lIndex = 1

Do While lIndex < Len(s)

'Print "ASCII at " + lIndex + " = " + Asc(Mid(s, lIndex, 1))

If Asc(Mid(s, lIndex, 1)) = 9 Then

s = ReplaceInString(s, lIndex, 1, " ")

bSomethingChanged = True

lIndex = lIndex + 3

End If

lIndex = lIndex + 1

'Print ":" + lIndex + "(" + s + ")"

Loop

If bSomethingChanged Then

oSelections.getByIndex(iWhichSelection).setString(s)

End If

Next

End Sub

Function ReplaceInString(s$, index&, num&, replaces$) As String

If index <= 1 Then

'Place this in front of the string

If num < 1 Then

ReplaceInString = replaces + s

ElseIf num > Len(s) Then

ReplaceInString = replaces

Else

ReplaceInString = replaces + Right(s, Len(s) - num)

End If

ElseIf index + num > Len(s) Then

ReplaceInString = Left(s,index - 1) + replaces

Else

ReplaceInString = Left(s,index - 1) + replaces + Right(s, Len(s) - index - num + 1)

End If

End Function

Setting Text Attributes

When this macro is run, it affects the paragraph containing the cursor. The font and the size is set. The CharPosture attribute controls italics, CharWeight controls bold, and CharUnderline controls the underline type. Valid values are found at: http://api.openoffice.org/docs/common/ref/com/sun/star/style/CharacterProperties.html http://api.openoffice.org/docs/common/ref/com/sun/star/awt/FontWeight.html http://api.openoffice.org/docs/common/ref/com/sun/star/awt/FontSlant.html http://api.openoffice.org/docs/common/ref/com/sun/star/awt/FontUnderline.html

Listing 7.26: Demonstrate how to set text attributes.

'******************************************************************

'Author: Andrew Pitonyak

'email: andrew@pitonyak.org

Sub SetTextAttributes

Dim document As Object

Dim Cursor

Dim oText As Object

Dim mySelection As Object

Dim Font As String

document=ThisComponent

oText = document.Text

Cursor = document.currentcontroller.getViewCursor()

mySelection = oText.createTextCursorByRange(Cursor.getStart())

mySelection.gotoStartOfParagraph(false)

mySelection.gotoEndOfParagraph(true)

mySelection.CharFontName="Courier New"

mySelection.CharHeight="10"

'Time to set Italic or NOT italic as the case with

'NONE, OBLIQUE, ITALIC, DONTKNOW, REVERSE_OBLIQUE, REVERSE_ITALIC

mySelection.CharPosture = com.sun.star.awt.FontSlant.ITALIC

'So you want BOLD text?

'DONTKNOW, THIN, ULTRALIGHT, LIGHT, SEMILIGHT,

'NORMAL, SEMIBOLD, BOLD, ULTRABOLD, BLACK

'These are really only constants where THIN is 50, NORMAL is 100

' BOLD is 150, and BLACK is 200.

mySelection.CharWeight = com.sun.star.awt.FontWeight.BOLD

'If underlining is your thing

'NONE, SINGLE, DOUBLE, DOTTED, DONTKNOW, DASH, LONGDASH,

'DASHDOT, DASHDOTDOT, SMALLWAVE, WAVE, DOUBLEWAVE, BOLD,

'BOLDDOTTED, BOLDDASH, BOLDLONGDASH, BOLDDASHDOT,

'BOLDDASHDOTDOT, BOLDWAVE

mySelection.CharUnderline = com.sun.star.awt.FontUnderline.SINGLE

'I have not experimented with this enough to know what the true

'implications of this really is, but I do know that it seems to set

'the character locale to German.

Dim aLanguage As New com.sun.star.lang.Locale

aLanguage.Country = "de"

aLanguage.Language = "de"

mySelection.CharLocale = aLanguage

End Sub

Insert text

Listing 7.27: Demonstrate how to insert strings into a text object.

'Author: Andrew Pitonyak

'email: andrew@pitonyak.org

Sub InsertSimpleText

Dim oDocument As Object

Dim oText As Object

Dim oViewCursor As Object

Dim oTextCursor As Object

oDocument = ThisComponent

oText = oDocument.Text

oViewCursor = oDocument.CurrentController.getViewCursor()

oTextCursor = oText.createTextCursorByRange(oViewCursor.getStart())

' Place the text to insert here

oText.insertString(oTextCursor, "—", FALSE)

End Sub

Insert new paragraph

Use insertString() to insert regular text. use insertControlcharacter() to insert special characters such as a new paragraph. The text range object, the example uses a text cursor, identifies where the text is inserted. The final boolean value specifies if the cursor should be expanded to include the newly inserted text. I use the value of False to not expand the cursor.

Listing 7.28: Insert a line break control character.

'Author: Andrew Pitonyak

'email: andrew@pitonyak.org

Sub InsertTextWithABreak

Dim oDoc

Dim oText

Dim oViewCursor

Dim oCursor

oText = ThisComponent.getText()

oViewCursor = ThisComponent.CurrentController.getViewCursor()

oCursor = oText.createTextCursorByRange(oViewCursor.getStart())

' Place the text to insert here

oText.insertString(oCursor, "— I am new text before the break -", FALSE)

oText.insertControlCharacter(oCursor, _

com.sun.star.text.ControlCharacter.LINE_BREAK, False)

oText.insertString(oCursor, "— I am new text after the break -", FALSE)

End Sub

Fields

Insert a formatted date field into a Write document

This will insert the text “Today is <date> ” where the date is formatted as “DD. MMM YYYY”. This will create the date format if it does not exist. For more information on valid formats, see the help contents on topic “number formats; formats”.

Listing 7.29: Insert a formatted date field into a Write document.

'Author: Andrew Pitonyak

'email: andrew@pitonyak.org

'uses: FindCreateNumberFormatStyle

Sub InsertDateField

Dim oDocument As Object

Dim oText As Object

Dim oViewCursor As Object

Dim oTextCursor As Object

Dim oDateTime As Object

oDocument = ThisComponent

If oDocument.SupportsService("com.sun.star.text.TextDocument") Then

oText = oDocument.Text

oViewCursor = oDocument.CurrentController.getViewCursor()

oTextCursor = oText.createTextCursorByRange(oViewCursor.getStart())

oText.insertString(oTextCursor, "Today is ", FALSE)

' Create the DateTime type.

ODateTime = oDocument.createInstance("com.sun.star.text.TextField.DateTime")

oDateTime.IsFixed = TRUE

oDateTime.NumberFormat = FindCreateNumberFormatStyle(_

"DD. MMMM YYYY", oDocument)

oText.insertTextContent(oTextCursor,oDateTime,FALSE)

oText.insertString(oTextCursor," ",FALSE) Else

MsgBox "Sorry, this macro requires a TextDocument"

End If

End Sub

Inserting a Note (Annotation)

Listing 7.30: Add a note at the cursor.

Sub AddNoteAtCursor

Dim vDoc

Dim vViewCursor

Dim oCursor

Dim vTextField

'Lets lie and say that this was added ten days ago!

'http://api.openoffice.org/docs/common/ref/com/sun/star/util/Date.html

Dim aDate As New com.sun.star.util.Date

With aDate

.Day = Day(Now - 10)

.Month = Month(Now - 10)

.Year = Year(Now - 10)

End With

vDoc = ThisComponent

vViewCursor = vDoc.getCurrentController().getViewCursor()

oCursor = vDoc.getText().createTextCursorByRange(vViewCursor.getStart())

' Unsichtbaren Cursor auf die aktuelle Position setzen.

'http://api.openoffice.org/docs/common/ref/com/sun/star/text/textfield/Annotation.html

vTextField = vDoc.createInstance("com.sun.star.text.TextField.Annotation")

With vTextField

.Author = "AP"

.Content = "It sure is fun to insert notes into my document"

'Ommit the date and it defaults to today!

.Date = aDate

End With

vDoc.Text.insertTextContent(oCursor, vTextField, False)

End Sub

Inserting A New Page

In my quest to insert a new page into a document, I stumbled across the following link:

http://api.openoffice.org/docs/common/ref/com/sun/star/style/ParagraphProperties.html

which discusses two properties. The PageNumberOffset states: “If a page break property is set at a paragraph, this property contains the new value for the page number.” The PageDescName property states: “If this property is set, it creates a page break before the paragraph it belongs to and assigns the value as the name of the new page style sheet to use.” I reasoned that if I set the PageDescName, then I could create a new page and set the page number. What was not said is that the PageDescName is the name of the new page style to use after the page break. If you do not use an existing page style, then this will fail!

Listing 7.31: Insert a page break.

Sub ExampleNewPage

Dim oSelections As Object, oSel As Object, oText As Object

Dim lSelCount As Long, lWhichSelection As Long

Dim oLCurs As Object, oRCurs As Object

oText = ThisComponent.Text

oSelections = ThisComponent.getCurrentSelection()

lSelCount = oSelections.getCount()

For lWhichSelection = 0 To lSelCount - 1

oSel = oSelections.getByIndex(lWhichSelection)

oLCurs = oText.CreateTextCursorByRange(oSel)

oLCurs.gotoStartOfParagraph(false)

oLCurs.gotoEndOfParagraph(true)

REM Preserve the existing page style!

oLCurs.PageDescName = oLCurs.PageStyleName

oLCurs.PageNumberOffset = 7

Next

End Sub

Removing Page Breaks

I have not thoroughly researched this, but I have done a few experiments. Setting the PageDescName causes a page break. It is also possible that the BreakType is set. The following macro detects and removes page breaks. I have only performed minimal testing. I have not concerned myself with new page offsets.

Listing 7.32: Find and remove page breaks.

Sub FindPageBreaks

REM Author: Andrew Pitonyak

Dim iCnt As Long

Dim oCursor as Variant

Dim oText As Variant

Dim s As String

oText = ThisComponent.Text

oCursor = oText.CreateTextCursor()

oCursor.GoToStart(False)

Do

If NOT oCursor.gotoEndOfParagraph(True) Then Exit Do

iCnt = iCnt + 1

If NOT IsEmpty(oCursor.PageDescName) Then

s = s & "Paragraph " & iCnt & " has a new page to style " & oCursor.PageDescName & CHR$(10)

oCursor.PageDescName = ""

End If

If oCursor.BreakType <> com.sun.star.style.BreakType.NONE Then

s = s & "Paragraph " & iCnt & " has a page break" & CHR$(10)

oCursor.BreakType = com.sun.star.style.BreakType.NONE

End If

Loop Until NOT oCursor.gotoNextParagraph(False)

MsgBox s

End Sub

Set The Document Page Style

The page style is set by modifying the Page Description name. This is very similar to starting a new page.

Listing 7.33: Set the page style for the entire document.

Sub SetDocumentPageStyle

Dim oCursor As Object

oCursor = ThisComponent.Text.createTextCursor()

oCursor.gotoStart(False)

oCursor.gotoEnd(True)

Print "Current style = " & oCursor.PageStyleName

oCursor.PageDescName = "Wow"

End Sub

Insert An OLE Object

The rumor is that with OpenOffice version 1.1, the following code will insert an OLE object into a write document. The CLSID may be an external OLE object.

Listing 7.34: Insert an OLE object.

obj = ThisComponent.createInstance("com.sun.star.text.TextEmbeddedObject")

obj.CLSID = "47BBB4CB-CE4C-4E80-A591-42D9AE74950F"

obj.attach( ThisComponent.currentController().Selection.getByIndex(0) )

If you select an embedded object in writer, you can access its API with:

oModel = ThisComponent.currentController().Selection.Model

This provides the same interface to the object as if you created the object by loading a document with loadComponentFromURL

Setting Paragraph Style

Many styles can be set directly to the selected text including the paragraph style.

Listing 7.35: Set the paragraph style for selected paragraphs to “Heading 2”.

Option Explicit

Sub SetParagraphStyle

Dim oSelections As Object, oSel As Object, oText As Object

Dim lSelCount As Long, lWhichSelection As Long

Dim oLCurs As Object, oRCurs As Object

oText = ThisComponent.Text

oSelections = ThisComponent.getCurrentSelection()

lSelCount = oSelections.getCount()

For lWhichSelection = 0 To lSelCount - 1

oSel = oSelections.getByIndex(lWhichSelection)

oSel.ParaStyleName = "Heading 2"

Next

End Sub

The following example will set all paragraphs to use the same style.

Listing 7.36: Set all paragraphs to use the same style.

'Author: Marc Messeant

'email: marc.liste@free.fr

Sub AppliquerStyle()

Dim oDocument As Object, oText As Object, oViewCursor as Object, oTextCursor As Object

oDocument = ThisComponent

oText = oDocument.Text

oViewCursor = oDocument.CurrentController.getViewCursor()

oTextCursor = oText.createTextCursorByRange(oViewCursor.getStart())

While oText.compareRegionStarts(oTextCursor.getStart(),oViewCursor.getEnd()) = 1

oTextCursor.paraStyleName = "YourStyle"

oTextCursor.gotoNextParagraph(false)

Wend

End Sub

Create Your Own Style

I did not test this code, I have not had time, but I have believe that it works.

Listing 7.37: Create a paragraph style.

vFamilies = ThisComponent.StyleFamilies

vStyle =ThisComponent.createInstance("com.sun.star.style.ParagraphStyle")

vParaStyles = vFamilies.getByName("ParagraphStyles")

vParaStyles.insertByName("MyStyle",vStyle)

Search And Replace

Searchable components support the ability to create a search descriptor. A searchable component can also find the first, next, and all occurrences of the search text. See:
http://api.openoffice.org/docs/common/ref/com/sun/star/util/XSearchable.html
A simple example demonstrates how to search (see Listing 7.38).

Listing 7.38: Perform a simple search based on words.

Sub SimpleSearchExample

Dim vDescriptor, vFound

' Create a descriptor from a searchable document.

vDescriptor = ThisComponent.createSearchDescriptor()

' Set the text for which to search and other

' http://api.openoffice.org/docs/common/ref/com/sun/star/util/SearchDescriptor.html

With vDescriptor

.SearchString = "hello"

' These all default to false

.SearchWords = true

.SearchCaseSensitive = False

End With

' Find the first one

vFound = ThisComponent.findFirst(vDescriptor)

Do While Not IsNull(vFound)

Print vFound.getString()

vFound.CharWeight = com.sun.star.awt.FontWeight.BOLD

vFound = ThisComponent.findNext( vFound.End, vDescriptor)

Loop

The object returned from findFirst and findNext behave very similarly to a cursor so most things that you can do to a cursor, such as setting attributes, can also be done to this object.

Replacing Text

Replacing text is very similar to searching text except that it must support:
http://api.openoffice.org/docs/common/ref/com/sun/star/util/XReplaceable.html
The only useful method that this provides that a searchable document does not have is the ability to replace all occurrences of the found text with something else. The idea being that if you search one at a time, then you can manually update each occurrence of the found text with the replacement text. The following example searches the text and replaces things such as “a@” with the Unicode character 257.

'Author: Birgit Kellner

'email: birgit.kellner@univie.ac.at

Sub AtToUnicode

'Andy says that sometime in the future these may have to be Variant types to work with Array()

Dim numbered(5) As String, accented(5) As String

Dim n as long

Dim oDocument as object, oReplace as object

numbered() = Array("A@", "a@", "I@", "i@", "U@", "u@", "Z@", "z@", "O@", "o@", "H@",_

"h@", "D@", "d@", "L@", "l@", "M@", "m@", "G@", "g@", "N@", "n@", "R@", "r@",_

"Y@", "y@", "S@", "s@", "T@", "t@", "C@", "c@", "j@", "J@")

accented() = Array(Chr$(256), Chr$(257), Chr(298), Chr$(299), Chr$(362), Chr$(363),_

Chr$(377), Chr$(378), Chr$(332), Chr$(333), Chr$(7716), Chr$(7717), Chr$(7692),_

Chr$(7693), Chr$(7734), Chr$(7735), Chr$(7746), Chr$(7747), Chr$(7748), Chr$(7749),_

Chr$(7750), Chr$(7751), Chr$(7770), Chr$(7771), Chr$(7772), Chr$(7773), Chr$(7778),_

Chr$(7779), Chr$(7788), Chr$(7789), Chr$(346), Chr$(347), Chr$(241), Chr$(209))

oReplace = ThisComponent.createReplaceDescriptor()

oReplace.SearchCaseSensitive = True

For n = LBound(numbered()) To UBound(accented())

oReplace.SearchString = numbered(n)

oReplace.ReplaceString = accented(n)

ThisComponent.ReplaceAll(oReplace)

Next n

End Sub

Searching Selected Text

The trick to searching only a selected range of text is to notice that a cursor may be used in the findNext routine. You can then check the end points of the find to see if the search went too far. This will also allow you to start searching from any cursor location. The findFirst method is not required if you already have a cursor type object to specify the starting search location with findNext. The example below uses my selected text framework and contains some enhancements suggested by Bernard Marcelly.

See Also:
http://api.openoffice.org/docs/common/ref/com/sun/star/text/XTextRangeCompare.html

'******************************************************************

'Author: Andrew Pitonyak

'email: andrew@pitonyak.org

Sub SearchSelectedText

Dim oCursors(), i%

If Not CreateSelectedTextIterator(ThisComponent, _

"Search text in the entire document?", oCursors()) Then Exit Sub

For i% = LBound(oCursors()) To UBound(oCursors())

SearchSelectedWorker(oCursors(i%, 0), oCursors(i%, 1), ThisComponent)

Next i%

End Sub

'******************************************************************

'Author: Andrew Pitonyak

'email: andrew@pitonyak.org

Sub SearchSelectedWorker(oLCurs, oRCurs, oDoc)

If IsNull(oLCurs) Or IsNull(oRCurs) Or IsNull(oDoc) Then Exit Sub

If oDoc.Text.compareRegionEnds(oLCurs, oRCurs) <= 0 Then Exit Sub

oLCurs.goRight(0, False)

Dim vDescriptor, vFound

vDescriptor = oDoc.createSearchDescriptor()

With vDescriptor

.SearchString = "Paragraph"

.SearchCaseSensitive = False

End With

' There is no reason to perform a findFirst.

vFound = oDoc .findNext(oLCurs, vDescriptor)

REM Would you kill for short-circuit evaluation?

Do While Not IsNull(vFound)

REM If Not vFound.hasElements() Then Exit Do

'See if we searched past the end

If -1 = oDoc.Text.compareRegionEnds(vFound, oRCurs) Then Exit Do

Print vFound.getString()

vFound = ThisComponent.findNext( vFound.End, vDescriptor)

Loop

End Sub

Complicated Search And Replace

'Deleting text between two delimiters is actually very easy

Sub deleteTextBetweenDlimiters

Dim vOpenSearch, vCloseSearch 'Open and Close descriptors

Dim vOpenFound, vCloseFound 'Open and Close find objects

' Create descriptors from the searchable document.

vOpenSearch = ThisComponent.createSearchDescriptor()

vCloseSearch = ThisComponent.createSearchDescriptor()

' Set the text for which to search and other

' http://api.openoffice.org/docs/common/ref/com/sun/star/util/SearchDescriptor.html

vOpenSearch.SearchString = "["

vCloseSearch.SearchString = "]"

' Find the first open delimiter

vOpenFound = ThisComponent.findFirst(vOpenSearch)

Do While Not IsNull(vOpenFound)

'Search for the closing delimiter starting from the open delimiter

vCloseFound = ThisComponent.findNext( vOpenFound.End, vCloseSearch)

If IsNull(vCloseFound) Then

Print "Found an opening bracket but no closing bracket!"

Exit Do

Else

' Clear the open bracket, if I do not do this, then I end up

' with only the text inside the brackets

vOpenFound.setString("")

' select the text inside the brackets

vOpenFound.gotoRange(vCloseFound, True)

Print "Found " & vOpenFound.getString()

' clear the text inside the brackets

vOpenFound.setString("")

' Clear the close bracket

vCloseFound.setString("")

' Do you really want to delete ALL of the spaces?

' If so, then do it here!

If vCloseFound.goRight(1, True) Then

If vCloseFound.getString() = " " Then vCloseFound.setString("")

End If

vOpenFound = ThisComponent.findNext( vOpenFound.End, vOpenSearch)

End If

Loop

End Sub

Search and Replace with Attributes and Regular Expressions

The macro surrounds all BOLD elements with curly brackets “{{ }}” and changes the Bold attribute to Normal. A regular expression is used to specify the search text.

Sub ReplaceFormatting

'original code : Alex Savitsky

'modified by : Laurent Godard

'The purpose of this macro is to surround all BOLD elements with {{ }}

'and change the Bold attribute to NORMAL

'This uses regular expressions

'The styles have to be searched too

Dim oDocument As Object

Dim oReplace As Object

Dim SrchAttributes(0) As New com.sun.star.beans.PropertyValue

Dim ReplAttributes(0) As New com.sun.star.beans.PropertyValue

oDocument = ThisComponent

oReplace = oDocument.createReplaceDescriptor

oReplace.SearchString = ".*" 'Regular expression. Match any text

oReplace.ReplaceString = "{{ & }}" 'Note the & places the found text back

oReplace.SearchRegularExpression=True 'Use regular expressions

oReplace.searchStyles=True 'We want to search styles

oReplace.searchAll=True 'Do the entire document

REM This is the attribute to find

SrchAttributes(0).Name = "CharWeight"

SrchAttributes(0).Value =com.sun.star.awt.FontWeight.BOLD

REM This is the attribute to replace it with

ReplAttributes(0).Name = "CharWeight"

ReplAttributes(0).Value =com.sun.star.awt.FontWeight.NORMAL

REM Set the attributes in the replace descriptor

oReplace.SetSearchAttributes(SrchAttributes())

oReplace.SetReplaceAttributes(ReplAttributes())

REM Now do the work!

oDocument.replaceAll(oReplace)

End Sub

Changing The Case Of Words

OOo determines the case of a word based on a character property. In theory this means that you can select the entire document and then set the character case. In practice, however, the selected portion may not support the character case property. As a compromise between speed and possible problems, I opted to use a word cursor to traverse the text setting the case of each word individually. I wrote the macro to work on entire words as an arbitrary decision. If you do not like it, change it. I used my selected text framework, so you require those macros for these to work.

If you find that you have text that does not support setting the character case, you can avoid the errors by adding the statement “On Local Error Resume Next” to SetWordCase().

Warning	Setting the case does not change the character, only how it is displayed. If you set the lower case attribute, you can not manually enter an upper case letter.
Warning	In OOo version 1.0.3.1, title case is broken; “heLLo” shows as “HeLLo”.

See Also:
http://api.openoffice.org/commmon/ref/com/sun/star/style/CaseMap.html

'******************************************************************

'Author: Andrew Pitonyak

'email: andrew@pitonyak.org

Sub ADPSetWordCase()

Dim oCursors(), i%, sMapType$, iMapType%

iMapType = -1

Do While iMapType < 0

sMapType = InputBox("To what case shall I set the words?" & chr(10) &_

"None, UPPER, lower, Title, or small caps?", "Change Case Type", "Title")

sMapType = UCase(Trim(sMapType))

If sMapType = "" Then sMapType = "EXIT"

Select Case sMapType

Case "EXIT"

Exit Sub

Case "NONE"

iMapType = com.sun.star.style.CaseMap.NONE

Case "UPPER"

iMapType = com.sun.star.style.CaseMap.UPPERCASE

Case "LOWER"

iMapType = com.sun.star.style.CaseMap.LOWERCASE

Case "TITLE"

iMapType = com.sun.star.style.CaseMap.TITLE

Case "SMALL CAPS"

iMapType = com.sun.star.style.CaseMap.SMALLCAPS

Case Else

Print "Sorry, " & sMapType & " is not a recognized valid type"

End Select

Loop

If Not CreateSelectedTextIterator(ThisComponent, _

"Change the entire document?", oCursors()) Then Exit Sub

For i% = LBound(oCursors()) To UBound(oCursors())

SetWordCase(oCursors(i%, 0), oCursors(i%, 1), ThisComponent.Text, iMapType%)

Next

End Sub

'******************************************************************

'Author: Andrew Pitonyak

'email: andrew@pitonyak.org

Function SetWordCase(vLCursor, vRCursor, oText, iMapType%)

If IsNull(vLCursor) OR IsNull(vRCursor) OR IsNull(oText) Then Exit Function

If oText.compareRegionEnds(vLCursor, vRCursor) <= 0 Then Exit Function

vLCursor.goRight(0, False)

Do While vLCursor.gotoNextWord(True)

If oText.compareRegionStarts(vLCursor, vRCursor) > 0 Then

vLCursor.charCasemap = iMapType%

vLCursor.goRight(0, False)

Else

Exit Function

End If

Loop

REM If the LAST word ends the document with no punctuation and new lines,

REM then it is not possible to goto the next word. I will now check for this case!

If oText.compareRegionStarts(vLCursor, vRCursor) > 0 AND vLCursor.gotoEndOfWord(True) Then

vLCursor.charCasemap = iMapType%

End If

End Function

Andrew Learns to Traverse Paragraphs

I wanted to traverse each paragraph and possible change the paragraph styles. To do this, I needed to select one paragraph at a time. My first attempt, which was wrong, involved a starting point of having a paragraph selected. I then moved right zero spaces to remove the selection from the current paragraph.

Listing 7.39: Move the cursor zero spaces to clear a selection.

vCurCursor.goRight(0, False)

This works fine, but it leaves the cursor in the current paragraph. In OOo, a paragraph is marked something like “blah blah blah.<cr><lf>”. When I use the method mentioned above, I leave the cursor sitting directly before the <cr><lf>, which is part of the current paragraph. When I used oCursor.gotoNextParagraph(True), I selected the <cr><lf> and moved the cursor to the start of the next paragraph. This is certainly NOT what I wanted. The proper way to move to the next paragraph and to select it is:

Listing 7.40: Proper method to select a paragraph.

vCurCursor.gotoNextParagraph(False) 'goto the start of the next paragraph.

vCurCursor.gotoEndOfParagraph(True) 'Select the entire paragraph.

To visit each paragraph and print its paragraph style, I use the macro listed below. Note that if I have more that one paragraph selected, I can not retrieve the paragraph style so it is important that I have a selection in only one paragraph at a time.

Listing 7.41: Print all paragraph styles.

Sub PrintAllStyles

Dim s As String

Dim vCurCursor as Variant

Dim oText As Variant

Dim sCurStyle As String

oText = ThisComponent.Text

vCurCursor = oText.CreateTextCursor()

vCurCursor.GoToStart(False)

Do

If NOT vCurCursor.gotoEndOfParagraph(True) Then Exit Do

sCurStyle = vCurCursor.ParaStyleName

s = s & """" & sCurStyle & """" & CHR$(10)

Loop Until NOT vCurCursor.gotoNextParagraph(False)

MsgBox s, 0, "Styles in Document"

End Sub

The final application was to walk this document setting the paragraph style for the code. When I have a single line macro, I want the style to be _code_one_line. If there are more than one line, then the first line is _code_first_line, the last line is _code_last_line, and all of the paragraphs in between are just _code. I was not very careful about end conditions or start conditions so this may not work if I have code as the first or last line; but I do not so I did not worry about it.

Sub user_CleanUpCodeSections

worker_CleanUpCodeSections("_code_first_line", "_code", "_code_last_line", "_code_one_line")

End Sub

REM I can not simply use goRight(0, False) to advance the cursor because I do not

REM want to end up catching the <NL> characters. Uggg!

Sub worker_CleanUpCodeSections(firstStyle$, midStyle$, lastStyle$, onlyStyle$)

Dim vCurCursor as Variant 'Current cursor

Dim vPrevCursor as Variant 'Previous cursor is one paragraph behind

Dim sPrevStyle As String 'Previous style

Dim sCurStyle As String 'Current style

REM Position the current cursor at the start of the second paragraph

vCurCursor = ThisComponent.Text.CreateTextCursor()

vCurCursor.GoToStart(False)

If NOT vCurCursor.gotoNextParagraph(False) Then Exit Sub

REM Position the previous cursor to select the first paragraph

vPrevCursor = ThisComponent.Text.CreateTextCursor()

vPrevCursor.GoToStart(False)

If NOT vPrevCursor.gotoEndOfParagraph(True) Then Exit Sub

sPrevStyle = vPrevCursor.ParaStyleName

Do

REM I can not simply use goRight(0,

If NOT vCurCursor.gotoEndOfParagraph(True) Then Exit Do

sCurStyle = vCurCursor.ParaStyleName

REM do the work here.

If sCurStyle = firstStyle$ Then

REM Current style is the first style

REM See if the previous style was also one of these!

Select Case sPrevStyle

Case onlyStyle$, lastStyle$

sCurStyle = midStyle$

vCurCursor.ParaStyleName = sCurStyle

vPrevCursor.ParaStyleName = firstStyle$

Case firstStyle$, midStyle$

sCurStyle = midStyle$

vCurCursor.ParaStyleName = sCurStyle

End Select

ElseIf sCurStyle = midStyle$ Then

REM Current style is the mid style

REM See if the previous style was also one of these!

Select Case sPrevStyle

Case firstStyle$, midStyle$

REM do nothing!

Case onlyStyle$

REM the last style was an only style, but it comes before a mid!

vPrevCursor.ParaStyleName = firstStyle$

Case lastStyle$

vPrevCursor.ParaStyleName = midStyle$

Case Else

sCurStyle = firstStyle$

vCurCursor.ParaStyleName = sCurStyle

End Select

ElseIf sCurStyle = lastStyle$ Then

Select Case sPrevStyle

Case firstStyle$, midStyle$

REM do nothing!

Case onlyStyle$

REM the last style was an only style, but it comes before a mid!

vPrevCursor.ParaStyleName = firstStyle$

Case lastStyle$

vPrevCursor.ParaStyleName = midStyle$

Case Else

sCurStyle = firstStyle$

vCurCursor.ParaStyleName = sCurStyle

End Select

ElseIf sCurStyle = onlyStyle$ Then

Select Case sPrevStyle

Case firstStyle$, midStyle$

sCurStyle = midStyle$

vCurCursor.ParaStyleName = sCurStyle

Case lastStyle$

sCurStyle = lastStyle$

vCurCursor.ParaStyleName = sCurStyle

vPrevCursor.ParaStyleName = midStyle$

Case onlyStyle$

sCurStyle = lastStyle$

vCurCursor.ParaStyleName = sCurStyle

vPrevCursor.ParaStyleName = firstStyle$

End Select

Else

Select Case sPrevStyle

Case firstStyle$

vPrevCursor.ParaStyleName = onlyStyle$

Case midStyle$

vPrevCursor.ParaStyleName = lastStyle$

End Select

End If

REM Done with the work so advance the trailing cursor

vPrevCursor.gotoNextParagraph(False)

vPrevCursor.gotoEndOfParagraph(True)

sPrevStyle = vPrevCursor.ParaStyleName

Loop Until NOT vCurCursor.gotoNextParagraph(False)

End Sub

What does it mean to enumerate text content?

If you enumerate something, you individually specify each item. A Text object is able to enumerate the text content that it contains. A text object enumerates paragraphs and text tables. In other words, a text object can individually return each paragraph and text table that it contains (see Listing 7.42).

Listing 7.42: Enumerate paragraph level text content.

Sub EnumerateParagraphs

REM Author: Andrew Pitonyak

Dim oParEnum 'Enumerator used to enumerate the paragraphs

Dim oPar 'The enumerated paragraph

REM Enumerate the paragraphs.

REM Tables are enumerated along with paragraphs

oParEnum = ThisComponent.getText().createEnumeration()

Do While oParEnum.hasMoreElements()

oPar = oParEnum.nextElement()

REM This avoids the tables. Add an else statement if you want to

REM process the tables.

If oPar.supportsService("com.sun.star.text.Paragraph") Then

MsgBox oPar.getString(), 0, "I found a paragraph"

ElseIf oPar.supportsService("com.sun.star.text.TextTable") Then

Print "I found a TextTable"

Else

Print "What did I find?"

End If

Loop

End Sub

Other objects are also able to enumerate content; a text paragraph is able to enumerate its text content as well. Enumeration can be used to find fields, bookmarks, and all sorts of other text content.

When simple text is enumerated, the returned text is grouped in sections with similar attributes. “Consider a simple text document that contains only this paragraph.” Listing 7.43 demonstrates how to simply enumerate a text paragraph.

Listing 7.43: Enumerate paragraph level text content.

Sub EnumerateContent

REM Author: Andrew Pitonyak

Dim oParEnum 'Enumerator used to enumerate the paragraphs

Dim oPar 'The enumerated paragraph

Dim oSectionEnum 'Enumerator used to enumerate the text sections

Dim oSection 'The enumerated text section

Dim s As String 'Contains the enumeration

Dim i As Integer 'Count the paragraphs

REM Enumerate the paragraphs.

REM Tables are enumerated along with paragraphs

oParEnum = ThisComponent.getText().createEnumeration()

Do While oParEnum.hasMoreElements()

oPar = oParEnum.nextElement()

REM This avoids the tables. Add an else statement if you want to

REM process the tables.

If oPar.supportsService("com.sun.star.text.Paragraph") Then

i = i + 1 : s = ""

REM Now, enumerate the text sections and look for graphics that

REM are anchored to a character, or as a character.

oSectionEnum = oPar.createEnumeration()

Do While oSectionEnum.hasMoreElements()

oSection = oSectionEnum.nextElement()

If oSection.TextPortionType = "Text" Then

REM This is a simply text object!

s = s & oSection.TextPortionType & " : " & oSection.getString() & CHR$(10)

Else

s = s & oSection.TextPortionType & " : " & CHR$(10)

End If

Loop

MsgBox s, 0, "Paragraph " & i

End If

Loop

End Sub

Figure 7.1: Enumerated paragraph.

A more complicated example is shown in Listing 7.44 in the next section, which enumerates graphics content. I also have more coverage in my book!

Enumerating text and finding text content

The primary reason to enumerate text content is to export the document. I was recently asked how to recognize graphics objects embedded in the text. The FindGraphics macro finds graphics objects that are anchored to a paragraph, anchored to a character, and inserted as a character. This does not find images anchored to the page.

The FindGraphics routine finds two types of graphics objects, the TextGraphicObject and the GraphicObjectShape. The text graphic object is designed to be embedded into a text object and is the type that is inserted when using Insert | Graphics for a Writer document. I can double click on a text graphic object and numerous properties are presented for the object; this is not the case for a graphic object shape.

The FindGraphics routine enumerates the contents of a text section based on a text graphic object. Experimentally, I can say that this finds both text graphic objects, and graphic object shapes.

Listing 7.44: Find graphics embedded in the text.

Sub FindGraphics

REM Author: Andrew Pitonyak

Dim oParEnum 'Enumerator used to enumerate the paragraphs

Dim oPar 'The enumerated paragraph

Dim oSectionEnum 'Enumerator used to enumerate the text sections

Dim oSection 'The enumerated text section

Dim oContentEnum 'Enum content, such as graphics objects

Dim oContent 'The numerated content

Dim msg1$, msg2$, msg3$, msg4$

Dim textGraphService$, graphicService$

textGraphService$ = "com.sun.star.text.TextGraphicObject"

graphicService$ = "com.sun.star.drawing.GraphicObjectShape"

msg1$ = "Found a TextGraphicObject anchored to a Paragraph: URL = "

msg2$ = "Found a GraphicObjectShape anchored to a Paragraph: URL = "

msg3$ = "Found a TextGraphicObject anchored to or as a character: URL = "

msg4$ = "Found a GraphicObjectShape anchored to or as a character: URL = "

REM Enumerate the paragraphs.

REM Tables are enumerated along with paragraphs

oParEnum = ThisComponent.getText().createEnumeration()

Do While oParEnum.hasMoreElements()

oPar = oParEnum.nextElement()

REM This avoids the tables. Add an else statement if you want to

REM process the tables.

If oPar.supportsService("com.sun.star.text.Paragraph") Then

REM If you want to see the types that are available for enumeration as

REM content associated with this paragraph, then look at the

REM available service names.

REM MsgBox Join(oPar.getAvailableServiceNames(), CHR$(10)

REM Typically, I use an empty string to enumerate ALL content,

REM but this causes a runtime error here. If any graphics images are

REM present, then they are enumerated as TextContent.

oContentEnum = oPar.createContentEnumeration("com.sun.star.text.TextContent")

Do While oContentEnum.hasMoreElements()

oContent = oContentEnum.nextElement()

If oContent.supportsService(textGraphService$) Then

Print msg1$ & oContent.GraphicURL

ElseIf oContent.supportsService(graphicService$) Then

Print msg2$ & oContent.GraphicURL

' EmbedLinkedGraphic(oContent)

'Else

' Inspect(oContent)

End If

Loop

REM Now, enumerate the text sections and look for graphics that

REM are anchored to a character, or as a character.

oSectionEnum = oPar.createEnumeration()

Do While oSectionEnum.hasMoreElements()

oSection = oSectionEnum.nextElement()

If oSection.TextPortionType = "Text" Then

REM This is a simply text object!

REM MsgBox oSection.TextPortionType & " : " & CHR$(10) & oSection.getString()

ElseIf oSection.TextPortionType = "Frame" Then

REM Use an empty string to enumerate ALL of the content

oContentEnum = oSection.createContentEnumeration(textGraphService$)

Do While oContentEnum.hasMoreElements()

oContent = oContentEnum.nextElement()

If oContent.supportsService(textGraphService$) Then

Print msg3$ & oContent.GraphicURL

ElseIf oContent.supportsService(graphicService$) Then

Print msg4$ & oContent.GraphicURL

' EmbedLinkedGraphic(oContent)

'Else

' Inspect(oContent)

End If

Loop

End If

Loop

End If

Loop

End Sub

But I only want to find the graphics objects

I tested this on a Writer document and it iterates through the graphics objects. This is certainly the fastest way to find graphic objects.

Listing 7.45: Find all items on a draw page.

Dim i As Integer

Dim oGraph

For i=0 To ThisComponent.Drawpage.getCount()-1

oGraph = ThisComponent.Drawpage.getByIndex(i)

Next i

Find a text field contained in the current paragraph?

I first looked at this problem form CPH (Mr. Hennessy), who wanted the text field at the start of the current paragraph. One option is to enumerate the text fields and check each field to see if it is anchored in the current paragraph. Although a text cursor can enumerate content, text fields are not included in the enumeration. If you only care about finding text fields, you can move your cursor one character at a time through the current paragraph looking for the text field (see Listing 7.46). A similar method is used to determine if the current cursor is contained in a text table or a cell (see Listing 7.1 and Listing 7.2).

Listing 7.46: Use the cursor to find a text field.

oTextCursor.gotoStartOfParagraph(False)

Do While oTextCursor.goRight(1, False) AND NOT oTextCursor.isEndOfParagraph()

If NOT IsEmpty(oTextCursor.TextField) Then

Print "Found a text field by moving the cursor through the text."

End If

Loop

Enumeration of the text content from a text cursor will enumerate graphics, but it will NOT enumerate a text field.

Listing 7.47: Enumerate text content.

oEnum = oTextCursor.createContentEnumeration("com.sun.star.text.TextContent")

Do While oEnum.hasMoreElements()

oSection = oEnum.nextElement()

Print "Enumerating TextContent: " & oSection.ImplementationName

Loop

The current paragraph can be enumerated from the text cursor.

Listing 7.48: Start an enumeration from a text cursor.

oEnum = oTextCursor.createEnumeration()

Do While oEnum.hasMoreElements()

v = oEnum.nextElement()

oSecEnum = v.createEnumeration()

Do While oSecEnum.hasMoreElements()

oSubSection = oSecEnum.nextElement()

If oSubSection.TextPortionType = "TextField" Then

REM Notice that the Textfield is accessed, you can also access a

REM TextFrame, TextSection, or a TextTable.

'Text field here

ElseIf oSubSection.TextPortionType = "Frame" Then

'Graphics here!

End If

Loop

Loop

Putting it all together in a single program yields the following:

Listing 7.49: Find the graphics and text fields in the current paragraph.

Sub GetTextFieldFromParagraph

Dim oEnum 'Cursor enumerator.

Dim oSection 'Current Section.

Dim s$ 'Generic string variable.

Dim oViewCursor 'Save typing ThisComponent.CurrentController.getViewCursor().

Dim oTextCursor 'Created text cursor.

Dim oText 'Text object that contains the view cursor

REM You require a view cursor because only the view knows where a line ends.

oViewCursor = ThisComponent.CurrentController.getViewCursor()

REM Use the text object that contains the view cursor.

oText = oViewCursor.Text

REM You require a text cursor so that you know where the paragraph ends.

REM Too bad the view cursor is not a paragraph cursor.

oTextCursor = oText.createTextCursorByRange(oViewCursor)

oTextCursor.gotoStartOfParagraph(False)

oTextCursor.gotoEndOfParagraph(True)

REM This does NOT work to enumerate text fields, but it enumerates graphics.

oEnum = oTextCursor.createContentEnumeration("com.sun.star.text.TextContent")

Do While oEnum.hasMoreElements()

oSection = oEnum.nextElement()

Print "Enumerating TextContent: " & oSection.ImplementationName

Loop

REM focus the cursor over the paragraph again.

oTextCursor.gotoStartOfParagraph(False)

oTextCursor.gotoEndOfParagraph(True)

REM And this provides the paragraph!

oEnum = oTextCursor.createEnumeration()

Dim v

Do While oEnum.hasMoreElements()

v = oEnum.nextElement()

Dim oSubSection

Dim oSecEnum

oSecEnum = v.createEnumeration()

s = "Enumerating section type: " & v.ImplementationName

Do While oSecEnum.hasMoreElements()

oSubSection = oSecEnum.nextElement()

s = s & CHR$(10) & oSubSection.TextPortionType

If oSubSection.TextPortionType = "TextField" Then

REM Notice that the Textfield is accessed, you can also access a

REM TextFrame, TextSection, or a TextTable.

s = s & " <== here is a text field " & oSubSection.TextField.ImplementationName

ElseIf oSubSection.TextPortionType = "Frame" Then

s = s & " <== here is a Frame "

End If

Loop

MsgBox s, 0, "Enumerate Single Paragraph"

Loop

REM Move the cursor through the document one character at a time and look

REM for a text field.

oTextCursor.gotoStartOfParagraph(False)

Do While oTextCursor.goRight(1, False) AND NOT oTextCursor.isEndOfParagraph()

If NOT IsEmpty(oTextCursor.TextField) Then

Print "Found a text field by moving the cursor through the text."

End If

Loop

End Sub

Where is the Display Cursor?

No time to be descriptive, but here is the e-mail with Giuseppe Castagno [castagno@tecsa-srl.it] who had the ideas.

You do a lot of interesting things but I think that it is not correct. First of all, the get position looks like it is relative to the first position on the top that can contain text. If there is a header, it is relative to that and if there is no header then it is from the top of the text frame. It looks like the top margin will be from the top of the page to the first position that can contain text.

Your measurements of the footer position are a pretty neat idea because it tells you the offset from the top of the footer to the cursor. I was impressed; had not thought about it. On the other hand, what if you increase the size of the footer? You do not take that into account I think.

You can probably do something more like:

Page height - top margin - cursor position

No need to move the cursor around.

Sub PrintCursorLocation

Dim xDoc

Dim xViewCursor

Dim s As String

xDoc = ThisComponent

xViewCursor = xDoc.CurrentController.getViewCursor()

s = xViewCursor.PageStyleName

Dim xFamilyNames As Variant, xStyleNames As Variant

Dim xFamilies

Dim xStyle, xStyles

xFamilies = xDoc.StyleFamilies

xStyles = xFamilies.getByName("PageStyles")

xStyle = xStyles.getByName(xViewCursor.PageStyleName)

' RunSimpleObjectBrowser(xViewCursor)

Dim lHeight As Long

Dim lWidth As Long

lHeight = xStyle.Height

lWidth = xStyle.Width

s = "Page size is " & CHR$(10) &_

" " & CStr(lWidth / 100.0) & " mm By " &_

" " & CStr(lHeight / 100.0) & " mm" & CHR$(10) &_

" " & CStr(lWidth / 2540.0) & " inches By " &_

" " & CStr(lHeight / 2540.0) & " inches" & CHR$(10) &_

" " & CStr(lWidth *72.0 / 2540.0) & " picas By " &_

" " & CStr(lHeight *72.0 / 2540.0) & " picas" & CHR$(10)

Dim dCharHeight As Double

Dim iCurPage As Integer

Dim dXCursor As Double

Dim dYCursor As Double

Dim dXRight As Double

Dim dYBottom As Double

Dim dBottomMargin As Double

Dim dLeftMargin As Double

dCharHeight = xViewCursor.CharHeight / 72.0

iCurPage = xViewCursor.getPage()

Dim v

v = xViewCursor.getPosition()

dYCursor = (v.Y + xStyle.TopMargin)/2540.0 + dCharHeight / 2

dXCursor = (v.X + xStyle.LeftMargin)/2540.0

dXRight = (lWidth - v.X - xStyle.LeftMargin)/2540.0

dYBottom = (lHeight - v.Y - xStyle.TopMargin)/2540.0 - dCharHeight / 2

' Print "Left margin = " & xStyle.LeftMargin/2540.0

dBottomMargin = xStyle.BottomMargin / 2540.0

dLeftMargin = xStyle.LeftMargin / 2540.0

s = s & "Cursor is " & Format(dXCursor, "0.##") & " inches from left " & CHR$(10)

s = s & "Cursor is " & Format(dXRight, "0.##") & " inches from right " & CHR$(10)

s = s & "Cursor is " & Format(dYCursor, "0.##") & " inches from top " & CHR$(10)

s = s & "Cursor is " & Format(dYBottom, "0.##") & " inches from bottom " & CHR$(10)

s = s & "Left margin = " & dLeftMargin & " inches" & CHR$(10)

s = s & "Bottom margin = " & dBottomMargin & " inches" & CHR$(10)

s = s & "Char height = " & Format(dCharHeight, "0.####") & " inches" & CHR$(10)

' RunSimpleObjectBrowser(xStyle)

' Dim dFinalX As Double

' Dim dFinalY As Double

' dFinalX = dXCursor + dLeftMargin

' dFinalY = (v.Y + xStyle.TopMargin)/2540 + dCharHeight / 2

' s = s & "Cursor in page is at (" & Format(dFinalX, "0.####") & ", " &_

' Format(dFinalY, "0.####") & ") in inches" & CHR$(10)

REM now check the footer!

' If xStyle.FooterIsOn Then

' v = IIF(iCurPage MOD 2 = 0, xStyle.FooterTextLeft, xStyle.FooterTextRight)

' If IsNull(v) Then v = xStyle.FooterText

' If Not IsNull(v) Then

' REM Save the postion

' Dim xOldCursor

' xOldCursor = xViewCursor.getStart()

' xViewCursor.gotoRange(v.getStart(), false)

' Print "footer position = " & CStr(xViewCursor.getPosition().Y/2540.0)

' dFinalY = xViewCursor.getPosition().Y/2540.0 - dYCursor + dBottomMargin

' xViewCursor.gotoRange(xOldCursor, false)

' End If

' Else

' Print "No footer"

' End If

' s = s & "Cursor in page is at (" & Format(dFinalX, "0.####") & ", " &_

' Format(dFinalY, "0.####") & ") in inches" & CHR$(10)

MsgBox s, 0, "Page information"

End Sub

Which cursor should I use to delete a line or a paragraph

The view cursor knows about lines and pages, the regular cursors know about words, sentences, and paragraphs.

Sub DeleteCurrentLine

Dim oVCurs

oVCurs = ThisComponent.getCurrentController().getViewCursor()

oVCurs.gotoStartOfLine(False)

oVCurs.gotoEndOfLine(True)

oVCurs.setString("")

End Sub

To delete the current paragraph, use require a paragraph cursor, which is not the view cursor. You only use the view cursor to find the current cursor position.

Sub DeleteParagraph

Dim oCurs

Dim oText

Dim oVCurs

oVCurs = ThisComponent.getCurrentController().getViewCursor()

REM Get the text object from the cursor, it is safer than assuming that

REM the high level document Text object contains the view cursor.

oText = oVCurs.getText()

oCurs = oText.createTextCursorByRange(oVCurs)

oCurs.gotoStartOfParagraph(False)

If oCurs.gotoNextParagraph(True) Then

oCurs.setString("")

Else

REM Then we were already AT the last paragraph

If oCurs.gotoPreviousParagraph(False) Then

oCurs.gotoEndOfParagraph(False)

oCurs.gotoNextParagraph(True)

oCurs.gotoEndOfParagraph(True)

oCurs.setString("")

Else

Rem There is one, and only one paragraph here

REM Remove it

oCurs.gotoStartOfParagraph(False)

oCurs.gotoEndOfParagraph(True)

oCurs.setString("")

End If

End If

End Sub

Delete the current page

To delete an entire page, requires the view cursor, because only the view cursor knows where a page starts and ends. Consider the following simplistic example:

Sub removeCurrentPage()

REM Author: Andrew Pitonyak

Dim oVCurs

Dim oCurs

oVCurs = ThisComponent.getCurrentController().getViewCursor()

If oVCurs.jumpToStartOfPage() Then

oCurs = ThisComponent.getText().CreateTextCursorByRange(oVCurs)

If (oVCurs.jumpToEndOfPage()) Then

oCurs.gotoRange(oVCurs, True)

oCurs.setString("")

Else

Print "Unable to jump to the end of the page"

End If

Else

Print "Unable to jump to the start of the page"

End If

End Sub

I have performed limited testing with this macro. If the page starts with a paragraph and ends with a paragraph, this may leave an extra empty paragraph in the text. This is most likely because the jumpToEndOfPage() method probably does not include the ending paragraph marker.

Insert an index or table of contents

The table of contents is simply another type of index. I have inserted sufficient comments that they should answer most of your questions as to how to do this.

Sub InsertATOC

REM Author: Andrew Pitonyak

Dim oCurs 'Used to insert the text content.

Dim oIndexes 'All of the existing indexes

Dim oIndex 'The TOC if it exists and a new one if not

Dim i As Integer 'Find an existing TOC

Dim bIndexFound As Boolean 'Flag to track if the TOC was found

REM First, find an existing TOC if it exists. If so,

REM then this will simply be updated.

oIndexes = ThisComponent.getDocumentIndexes()

bIndexFound = False

For i = 0 To oIndexes.getCount() - 1

oIndex = oIndexes.getByIndex(i)

If oIndex.supportsService("com.sun.star.text.ContentIndex") Then

bIndexFound = True

Exit For

End If

Next

If Not bIndexFound Then

Print "I did not find an existing content index"

REM Perhaps you should create and insert a new one!

REM Notice that this MUST be created by the document that will contain

REM the index.

oIndex = ThisComponent.createInstance("com.sun.star.text.ContentIndex")

REM On my system, these are the default values

REM How do you want to create the index?

REM CreateFromChapter = False

REM CreateFromLevelParagraphStyles = False

REM CreateFromMarks = True

REM CreateFromOutline = False

oIndex.CreateFromOutline = True

REM You can set all sorts of other things such as the

REM Title or Level

oCurs = ThisComponent.getText().createTextCursor()

oCurs.gotoStart(False)

ThisComponent.getText().insertTextContent(oCurs, oIndex, False)

End If

REM Even the newly inserted index is not updated until right HERE!

oIndex.update()

End Sub

Inserting a URL into a Write document

Although a Calc document stores URLs in a URL text field, as shown elsewhere in this document, Write documents identify contained URLs based on character properties. A link becomes a link, when the HyperLinkURL property is set.

Sub InsertURLAtTextCursor

Dim oText 'Text object for the current object

Dim oVCursor 'Current view cursor

oVCursor = ThisComponent.getCurrentController().getViewCursor()

oText = oVCursor.getText()

oText.insertString(oVCursor, "andrew@pitonyak.org", True)

oVCursor.HyperLinkTarget = "mailto:andrew@pitonyakorg"

oVCursor.HyperLinkURL = "andrew@pitonyak.org"

' oVCursor.HyperLinkName = "andrew@pitonyak.org"

' oVCursor.UnvisitedCharStyleName = "Internet Link"

' oVCursor.VisitedCharStyleName = "Visited Internet Link"

End Sub

Sorting Text

A text cursor can be used to sort data in a Write document.

Sub SortTextInWrite

Dim oText 'Text object for the current object

Dim oVCursor 'Current view cursor

Dim oCursor 'Text cursor

Dim oSort

Dim i%

Dim s$

REM Assume that we want to sort the selected text!

REM Unfortunately, the view cursor can NOT create a sort descriptor.

REM Create a new text cursor, that can create a sort descriptor.

oVCursor = ThisComponent.getCurrentController().getViewCursor()

oText = oVCursor.getText()

oCursor = oText.createTextCursorByRange(oVCursor)

oSort = oCursor.createSortDescriptor()

' On Error Resume Next

' For i = LBound(oSort) To UBound(oSort)

' s = s & "(" & oSort(i).Name & ", "

' s = s & oSort(i).Value

' s = s & ")" & CHR$(10)

' Next

' MsgBox s, 0, "Sort Properties"

oCursor.sort(oSort)

End Sub

Use the SortDescriptor2, the SortDescriptor has been deprecated. See:
http://api.openoffice.org/docs/common/ref/com/sun/star/text/TextSortDescriptor2.html
http://api.openoffice.org/docs/common/ref/com/sun/star/table/TableSortDescriptor2.html

The default values for the sort descriptor seems to be: (IsSortInTable, False), (Delimiter, 32), (IsSortColumns, True), (MaxSortFieldsCount, 3), (SortFields, ). To set the sort order and Locale, you need to modify the SortFields.

Outline numbering

I have been asked a few times how to change which styles are used for outline numbering. The first step in setting the outline numbering is to have a paragraph style. The macro in Listing 7.50 creates a custom paragraph style with the specified character height. The parent style is set to “Heading”. You will want to change the paragraph style to fit your requirements.

Listing 7.50: Create a custom paragraph style.

Function CreateParaStyle(oDoc, NewParaStyle, nCharHeight%)

Dim pFamilies, pStyle, pParaStyles

pFamilies = oDoc.StyleFamilies

pParaStyles = pFamilies.getByName("ParagraphStyles")

If Not pParaStyles.hasByName(NewParaStyle) then

pStyle = oDoc.createInstance("com.sun.star.style.ParagraphStyle")

pStyle.setParentStyle("Heading")

pStyle.CharHeight = nCharHeight

pParaStyles.insertByName(NewParaStyle, pStyle)

End if

End Function

After you have created your paragraph styles, or at least chosen the paragraph styles to use, you can set the numbering. The macro in Listing 7.51 accepts an array of paragraph style names and sets the outline numbering to use these styles.

The outline numbering information is stored in the chapter numbering rules object. Obtain each rule using getByIndex(), which returns an array of properties. Inspect the name of each property to find the property that you want to change. Each property is copied OUT of the array. If the properties were stored as an UNO Service rather than an UNO structure, then a reference would be copied from the array rather than copy (I explain the copy by value rather than copy by reference behavior in my book). After finding and modifying the appropriate properties, the rule is copied back into the rules object.

Listing 7.51: Set the outline numbering

Sub SetNumbering(sNames())

Dim i%, j%

Dim oRules

Dim oRule()

Dim oProp

oRules = ThisComponent.getChapterNumberingRules()

For i = 0 To UBound(sNames())

If i >= oRules.getCount() Then Exit Sub

oRule() = oRules.getByIndex(i)

REM I do not set the following:

REM Adjust, StartWith, LeftMargin, SymbolTextDistance, FirstLineOffset

For j = LBound(oRule()) To Ubound(oRule())

REM oProp is only a copy of the property.

REM You must assign the property back into the array.

oProp = oRule(j)

Select Case oProp.Name

Case "HeadingStyleName"

oProp.Value = sNames(i)

Case "NumberingType"

oProp.Value = com.sun.star.style.NumberingType.ARABIC

Case "ParentNumbering"

oProp.Value = i + 1

Case "Prefix"

oProp.Value = ""

Case "Suffix"

oProp.Value = " "

'Case "CharStyleName"

' oProp.Value =

End Select

oRule(j) = oProp

Next

oRules.replaceByIndex(i, oRule())

Next

End Sub

If the array passed to Listing 7.51 contains three entries, then only the first three entries in the outline numbering are modified. Use the code as a starting point. Listing 7.52 demonstrates how to use both Listing 7.50 and Listing 7.51.

Listing 7.52: Set and use the outline numbering

Sub SetOutlineNumbering

CreateParaStyle(ThisComponent, "_New_Heading_1", 16)

CreateParaStyle(ThisComponent, "_New_Heading_2", 14)

setNumbering(Array("_New_Heading_1", "_New_Heading_2"))

End Sub

Insert a table of contents (TOC) or other index.

The following code inserts a table of contents TOC into a document. If the TOC already exists, then the update method is called on the existing index. Use the dispose method to remove an existing index from the document.

Sub InsertATOC

REM Author: Andrew Pitonyak

Dim oCurs 'Used to insert the text content.

Dim oIndexes 'All of the existing indexes

Dim oIndex 'The TOC if it exists and a new one if not

Dim i As Integer 'Find an existing TOC

Dim bIndexFound As Boolean 'Flag to track if the TOC was found

REM First, find an existing TOC if it exists. If so,

REM then this will simply be updated.

oIndexes = ThisComponent.getDocumentIndexes()

bIndexFound = False

For i = 0 To oIndexes.getCount() - 1

oIndex = oIndexes.getByIndex(i)

If oIndex.supportsService("com.sun.star.text.ContentIndex") Then

bIndexFound = True

Exit For

End If

Next

If Not bIndexFound Then

Print "I did not find an existing content index"

REM Perhaps you should create and insert a new one!

REM Notice that this MUST be created by the document that will contain

REM the index.

oIndex = ThisComponent.createInstance("com.sun.star.text.ContentIndex")

REM On my system, these are the default values

REM How do you want to create the index?

REM CreateFromChapter = False

REM CreateFromLevelParagraphStyles = False

REM CreateFromMarks = True

REM CreateFromOutline = False

oIndex.CreateFromOutline = True

REM You can set all sorts of other things such as the

REM Title or Level

oCurs = ThisComponent.getText().createTextCursor()

oCurs.gotoStart(False)

ThisComponent.getText().insertTextContent(oCurs, oIndex, False)

End If

REM Even the newly inserted index is not updated until right HERE!

oIndex.update()

End Sub

Text tables

Column Widths

The column separator specifies where the column ends as percentage of the table width. A column end position of 5000 specifies 50% of the table width. The macro in Listing 7.53 sets the first column to end at 50% of the current table width and the second column at 70% of the total table width.

A table provides this property only if all rows have the same structure. In other words, you can not set the column width for an entire table on a complex table. Also, if a particular separator has the IsVisible flag set to false, then it is not visible. Hidden separators cannot be moved and they cannot be overtaken by visible separators.

Listing 7.53: Set column width for the first two columns.

Sub SetTwoColsWidths

Dim oTblColSeps 'The array of table column separators.

Dim oTable 'The first text table in the document.

'Print

oTable = ThisComponent.getTextTables().getByIndex(0)

oTblColSeps = oTable.TableColumnSeparators

Rem Change the positions of the two separators.

oTblColSeps(0).Position = 5000

oTblColSeps(1).Position = 7000

REM You must assign the array back

oTable.TableColumnSeparators = oTblColSeps

End Sub

Setting the optimal column width

My book, OpenOffice.org Macros Explained, discusses text tables at some length. It does not discuss how to set the optimal column width, however. In a Calc document, you set the OptimalWidth column property to True. There is no simple solution for a text table.

Tip	See pages 310 – 311 in my book for more information on text tables.

The GUI provides a method that can set the width of a column based on the location of the text cursor, or the portion of the text table that is selected. This method is available by using a dispatch. My book explains how to select areas in a text table, so I will not repeat that discussion here. The macro in Listing 7.54 selects an entire text table and then sets the column width for the entire text table.

Listing 7.54: Set an entire table for optimal column width.

Sub SetTableOptimumWidth

Dim oDispHelper 'Dispatch helper

Dim oFrame 'Current window frame.

Dim oTable 'First table in the document.

Dim oVCursor 'The view cursor

oTable = ThisComponent.getTextTables().getByIndex(0)

ThisComponent.getCurrentController().select(oTable)

oVCursor = ThisComponent.getCurrentController().getViewCursor()

oVCursor.gotoEnd(True)

oVCursor.gotoEnd(True)

oFrame = ThisComponent.CurrentController.Frame

oDispHelper = createUnoService("com.sun.star.frame.DispatchHelper")

oDispHelper.executeDispatch(oFrame, ".uno:SetOptimalColumnWidth", "", 0, Array())

End Sub

How wide is a TextTable?

On the surface, it seems very easy to determine the width of a text table; access the Width property. This is, unfortunately, not sufficient. To determine the actual width of a text table, you must inspect the properties shown in Table 7.1.

Table 7.1: Text table properties related to the text table width.

Property	Description
LeftMargin	Left margin of the table.
RightMargin	Right margin of the table.
HoriOrient	Contains the horizontal orientation from the com.sun.star.text.HoriOrientation constant group.
RelativeWidth	Determines the width of the table relative to its environment.
IsWidthRelative	Determines if the value of the relative width is valid.
Width	Sometimes this contains the absolute table width.

In my book (page 307), I mention the HoriOrient as controlling the meaning of the other properties. If the HoriOrient property contains the default value FULL, then the properties are essentially useless, including the Width property. In this case, you must determine the width of the column that contains the text table. I could elaborate, but I have been answering macro questions for hours and I have other work to do.

The cursor in a text table

You can check to see if the cursor is inside of a text table using the code in Listing 7.2, this code also demonstrates how to determine if more than a single cell is selected. The macro in Listing 7.55 prints information about text cursor in a text table.

Listing 7.55: Inspect the text table that contains the cursor.

Sub InspectCurrentTable

Dim oTable 'The table that contains the cursor.

Dim oCell 'The cell that contains the cursor.

Dim oVCurs 'The current view cursor.

Dim s$ 'Contains explanatory text.

Dim nCol% 'The column that contains the cursor.

Dim nRow% 'The row that contains the cursor.

oVCurs = ThisComponent.getCurrentController().getViewCursor()

If IsEmpty(oVCurs.TextTable) Then

s = s & "The cursor is NOT in a text table"

Else

oTable = oVCurs.TextTable

oCell = oVCurs.Cell

REM Assume less than 26 columns

nCol = Asc(oCell.Cellname) - 65

nRow = CInt(Right(oCell.Cellname, Len(oCell.Cellname) - 1)) - 1

s = s & "The cursor is in text table " & oTable.getName() & CHR$(10)

s = s & "The current cell is " & oCell.Cellname & CHR$(10)

s = s & "The cell is at (" & nCol & ", " & nRow & ")" & CHR$(10)

s = s & "The table has " & oTable.getColumns().getCount() & _

" columns and " & oTable.getRows().getCount() & " Rows" & CHR$(10)

REM *** Insert more code here!

End If

MsgBox s

End Sub

To select an entire row, first move the cursor so the first cell in the row:

oCell1 = oTable.getCellByPosition(0, nRow)

ThisComponent.getCurrentController().select(oCell1)

Next, select the entire cell. If the cell contains text, oVCurs.gotoEnd(True) moves the cursor to the end of the text in the current cell. If the cursor is already at the end of the cell, such as when the cell does not contain any text, then the cursor will move to the end of the table. The gotoEndOfLine() method always moves the cursor to the end of the current line, which is fine if the cell contains only one line of text. After selecting the entire cell, you can move the view cursor to the right to select the rest of the cells. The code in Listing 7.56 is written to assume that it is inserted into the code in Listing 7.55.

Listing 7.56: Select the entire row of a simple text table.

Dim oCell1

Dim oText

oCell1 = oTable.getCellByPosition(0, nRow)

ThisComponent.getCurrentController().select(oCell1)

oText = oCell1.getText()

If oText.compareRegionStarts(oText.getStart(), oText.getEnd()) <> 0 Then

oVCurs.gotoEnd(True)

End If

oVCurs.goRight(oTable.getColumns().getCount()-1, True)

Text sections

A TextSection is a range of complete paragraphs contained a text object. The content may be the content of a link into another document, a link from the same document, or the result of a DDE operation. TextSection instances can be linked from, and to, other texts. The contents of a text section are enumerated along with regular text and can be traversed with a text cursor. The text is traversed even if it is marked as not visible, which you can check with the oSection.IsVisible property.

Listing 7.57: Display the text in the first text section

REM Author: Andrew Pitonyak

Sub GetTextFromTextSection

Dim oSection

Dim oCurs

If ThisComponent.getTextSections().getCount() = 0 Then

Print "There are no text sections"

Exit Sub

End If

REM You can get a text section by name or index.

'oSection = ThisComponent.getTextSections().getByName("Special")

oSection = ThisComponent.getTextSections().getByIndex(0)

REM Create a cursor and move the cursor to the text section.

oCurs = ThisComponent.getText().createTextCursor()

oCurs.gotoRange(oSection.getAnchor(), False)

REM In this example, I assume that there is text after

REM the text section. If there is not, then this is

REM an infinite loop. You had better verify that

REM gotoNextParagraph does not return False.

Do While NOT IsEmpty(oCurs.TextSection)

oCurs.gotoNextParagraph(False)

Loop

oCurs.gotoPreviousParagraph(False)

oCurs.gotoRange(oSection.getAnchor(), True)

MsgBox oCurs.getString()

End Sub

Forms

Warning	I know very little about forms so the information contained here may not be entirely accurate! The Developer's Guide has some excellent material on forms.

Frank Schönheit [fs@openoffice.org] has the following to say:

To update an awt-control, make changes to the model, and the control which belongs to the model is automatically updated to be in sync with the model. Changing the control directly may lead to some inconsistency. For example, for a list box, do not use the XListBox interface provided by the control for selecting an item (XListBox::selectItem), but rather using the com.sun.star.awt.UnoControlListBoxModel::SelectedItems property of the model. http://api.openoffice.org/docs/common/ref/com/sun/star/awt/UnoControlListBoxModel.html

Introduction

A form or form document is a set of forms and/or controls such as a button or combo-box. Forms may be used to access data sources and other complicated things.

See Also:
http://api.openoffice.org/docs/common/ref/com/sun/star/form/XFormsSupplier.html
http://api.openoffice.org/docs/common/ref/com/sun/star/form/module-ix.html

To obtain the form, you must first obtain the draw page. The method to do this varies depending upon the document type. As a test, I inserted a button into a spreadsheet. I named the button “TestButton” and the form “TestForm”. I then created the following macro that changes the button label when it is clicked.

Listing 8.1: Change a button's label in a Calc document

Sub TestButtonClick

Dim vButton, vForm

vForm=THISCOMPONENT.CurrentController.ActiveSheet.DrawPage.Forms.getByName("TestForm")

vButton = vForm.getByName("TestButton")

vButton.Label = "Wow"

Print vButton.getServiceName()

End Sub

If this had been a write document, you would obtain the form as follows:

oForm=THISCOMPONENT.DrawPage.Forms.getByName("FormName")

Dialogs

Most dialog examples start as follows:

Dim oDlg As Object

Sub StartDialog

oDlg = CreateUnoDialog(DialogLibraries.Standard.Dialog1 )

oDlg.execute()

End Sub

Notice that there is a variable called oDlg that has scope outside of the method that creates it. This is required because the dialog is manipulated by other subroutines that are called as event handlers. If these subroutines will access the dialog then they must be able to access a variable that references it.

Dialogs, like macro libraries, have their own hierarchy. In this example, I entered the macro code shown above. I then chose Tools->Macros and then I clicked on the “Organizer” button. You will notice that this is organizing things under the document with a section labeled Standard. When you click on the “New Dialog” button, the default dialog name is “Dialog1”. Because this code is run from a macro embedded in a document, DialogLibraries refers to the Document's library hierarchy. If you want to access the application library hierarchy from a Document's macro you must use GlobalScope.DialogLibraries.

The standard method of closing a dialog involves setting up an event handler that closes the dialog. I usually add a “close” button that calls a method similar to the following macro.

Sub CloseDialog

oDlg.endExecute()

End Sub

Please forgive the great amount of detail present, but I feel that it is required for beginners. While editing my new dialog, I clicked on the “control” button on the tool-bar and I chose a command button. I then inserted the button. I right clicked the button and chose properties. From the General tab, I set the name of the button to “ExitButton” and the label to “Exit”. I then clicked on the “Events” tab and next to “When Initiating” I clicked on “...” to open the dialog that will allow me to assign actions to events. In the event section, I chose “ When Initiating”. In the “Macro” section, I selected the “CloseDialog” subroutine and then I clicked on the “Assign” button. Although this handles both a mouse or keyboard activation, it is possible to have a different subroutine for “Key pressed” or “Mouse clicked” but I have no reason to differentiate.

Tip	You must have a variable referencing the dialog that has scope outside the subroutine that creates it so that other subroutines can access it.
Tip	From a document macro, DialogLibraries.Standard.Dialog1 references a dialog in the current document; GlobalScope.DialogLibraries.Standard... references a global dialog.

Controls

Controls all share certain common features. A few are as follows:
http://api.openoffice.org/docs/common/ref/com/sun/star/awt/UnoControl.html
http://api.openoffice.org/docs/common/ref/com/sun/star/awt/XWindow.html
http://api.openoffice.org/docs/common/ref/com/sun/star/awt/module-ix.html
This allows controlling things such as visibility, enabled, size, and other common features. Many controls share common methods such as setLabel(string). Many different event types are supported. In my experience, the most commonly used events are for notification of a state change on the control.

A control may be obtained from a dialog using the getControl(control_name) method. It is also possible to iterate through all of the controls if you desire.

Control Label

A label acts as regular text in the dialog box. It is usually used to label a control. It is possible to get and set the label text using getText() and setText(string). It is also possible to specify the alignment of this text as left, centered, or right justified. It is common to right justify the text of a label so that it is closer to the control that it labels. See:
http://api.openoffice.org/docs/common/ref/com/sun/star/awt/XFixedText.html

Control Button

Usually, a control button is only used to call a subroutine when a button is pressed. It is also possible to call setLabel(string) to change the button label. See also:
http://api.openoffice.org/docs/common/ref/com/sun/star/awt/XButton.html

Text Box

A text box is used to hold standard text. It is possible to limit the maximum text length and control the maximum number of lines. It is possible to write your own formatting controls if you desire. The most commonly used methods are getText() and setText(string). If you want a scroll bar, you should set it from the properties while designing the dialog.

There are special input boxes for dates, time, numerics, pattern, formatted, and currency. If you insert one, be certain to pay careful attention to the properties to see what they can do. You can turn off strict format checking and provide limited input ranges, for example. A pattern field has an input mask and a character mask. The input mask determines which user data can be entered. The character mask determines the state of the masked field when loading the form. The formatted field allows arbitrary formatting as allowed by OOo. If I wanted a field for social security number or percentages, I would use this field.

See:
http://api.openoffice.org/docs/common/ref/com/sun/star/awt/XTextComponent.html
http://api.openoffice.org/docs/common/ref/com/sun/star/awt/XTimeField.html
http://api.openoffice.org/docs/common/ref/com/sun/star/awt/XDateField.html
http://api.openoffice.org/docs/common/ref/com/sun/star/awt/XCurrencyField.html
http://api.openoffice.org/docs/common/ref/com/sun/star/awt/XNumericField.html
http://api.openoffice.org/docs/common/ref/com/sun/star/awt/XPatternField.html

List Box

A list box provides a list of values from which you may select a value. You can choose to enable multiple selections. To add items to a list box, I usually use something similar to addItems(Array("one", "two", "three"), 0). It is also possible to remove items from a list box.

For a single selection, you can use getSelectedItemPos() to determine which item is selected. A -1 is returned if nothing is selected. If something is selected, 0 means the first item in the list. For multiple selections, use getSelectedItemsPos() which returns a sequence of shorts. See: http://api.openoffice.org/docs/common/ref/com/sun/star/awt/XListBox.html

Combo Box

A combo box is an input field with an attached list box. This is sometimes called a drop down control. In my example, I set the combo box in two stages. First, I set the list box values and then I set the input box to properties.

aControl.addItems(Array("properties", "methods", "services"), 0)

aControl.setText("properties")

I then went to events and indicated that when the “Item status changed” the NewDebugType subroutine should be called. This will display all of the methods, properties, or services supported by the dialog. I did this to demonstrate a call back event that actually shows useful debug information. See:
http://api.openoffice.org/docs/common/ref/com/sun/star/awt/XComboBox.html

Check Box

Although a check box is usually only used to indicate a single state of yes or no, there is a common check box called a tristate check box. In OOo, a check box can have a state of 0, not checked, or 1, checked. You use getState() to obtain the current state. If you call enableTriState(true), then a state of 2 is allowed. This state has a check mark in the box but then the box becomes Dim. You can set the state using setState(int). See:
http://api.openoffice.org/docs/common/ref/com/sun/star/awt/XCheckBox.html

Option/Radio Button

The purpose of an radio button is usually to select one item from a group of items. Because of this, the typical usage in a dialog is to first insert a group box and then place the option buttons inside of the group box. To determine which one of the radio buttons has been selected, you call the getState() method on each of the radio buttons until you find the one that is selected. I could have used radio buttons rather than a drop down list in my example to choose what to display in my debug list box. See:
http://api.openoffice.org/docs/common/ref/com/sun/star/awt/XRadioButton.html

Progress Bar

In my example, I use a progress bar to show the progress of filling in the debug list box. This is probably not a good example because it happens so quickly, but it is still an example.

You can set the range of the progress bar using setRange(min, max). This makes it easier to report your progress. Because I am processing a string, I set the min to 0 and the max to the length of the string. I then call setValue(int) with the current position in the string to show how far along I am. See:
http://api.openoffice.org/docs/common/ref/com/sun/star/awt/XProgressBar.html

Obtaining Controls

If you want to enumerate the controls in a document form, the following will work

Listing 8.2: Enumerate the controls in a form.

Sub EnumerateControlsInForm

Dim oForm, oControl, iNumControls%, i%

'By default this is where the controls are

oForm = ThisComponent.Drawpage.Forms.getByName("Standard")

oControl = oForm.getByName("MyPushButton")

MsgBox "Used get by name to get control named " & oControl.Name

iNumControls = oForm.Count()

For i = 0 To iNumControls -1

MsgBox "Control " & i & " is named " & oControl.Name

Next

End Sub

To the controls in a dialog, use code as follows:

Listing 8.3: Enumerate the controls in a dialog.

x = oDlg.getControls()

For ii=LBound(x) To UBound(x)

Print x(ii).getImplementationName()

Next

Usually, the controls will be retrieved by name rather than by enumeration.

Size and location of a Control by name.

Paolo Mantovani [mantovani.paolo@tin.it] indicated that a form control is placed on a drawing shape (com.sun.star.drawing.XControlShape), so you must obtain the shape underlying the control to manage the size and position. The Tools Library (module "ModuleControls") supplies some facilities in order to work with form controls. Check those functions:

GetControlModel()

GetControlShape()

GetControlView()

I wrote the following macro:

Listing 8.4: Obtain a control and it's shape by name.

Sub SeeThingProp

Dim oForm, oControl, iNumControls%, i%

Dim v()

'By default this is where the controls are

oForm = ThisComponent.Drawpage.Forms.getByName("Standard")

oControl = oForm.getByName("CheckBox")

Dim vShape

Dim vPosition, vSize

Dim s$, vv

vShape = GetControlShape(ThisComponent, "CheckBox")

vPosition = vShape.getPosition()

vSize = vShape.getSize()

s = s & "Position = (" & vPosition.X & ", " & vPosition.Y & ")" & CHR$(10)

s = s & "Height = " & vSize.Height & " Width = " & vSize.Width & CHR$(10)

MsgBox s

End Sub

Which control called a handler and where is it located?

Consider a text table containing buttons. All of the buttons call the same macro. Which cell contains the button?

Add an argument to button handler. The argument contains the “Source” property, which references the button.

Control shapes contain contain the “Control” property, which references the control's model. Iterate through the shapes and compare the shape's model to the control's model.

The following macro assumes that all returned shapes are control shapes, you probably want to verify that this is true.

Listing 8.5: Find a control's shape if you do NOT know the name.

Sub ButtonCall(x)

Dim oButton ' Button that was used to call the handler.

Dim oModel ' The model for the button.

Dim oShape ' The underlying button shape.

Dim i As Long ' Generic index variable.

Dim bFound As Boolean ' Set to true when the matching shape is found.

REM First, get the button used to call this routine.

REM Save the button's model.

oButton = x.Source

oModel = oButton.getModel()

REM Iterate through the controls

i = ThisComponent.getDrawPage().getCount()

bFound = False

Do While (i > 0 AND NOT bFound)

i = i - 1

oShape = ThisComponent.getDrawPage().getByIndex(i)

bFound = EqualUNOObjects(oShape.Control, oModel)

Loop

If bFound Then

Print "The button is in cell " & oShape.getAnchor().Cell.CellName

End If

End Sub

Choosing a File Using the File Dialog

The following example displays the standard choose file dialog.

Listing 8.6: Using the standard choose file dialog.

Sub ExampleGetAFileName

Dim filterNames(1) As String

filterNames(0) = "*.txt"

filterNames(1) = "*.sxw"

Print GetAFileName(filterNames())

End Sub

Function GetAFileName(Filternames()) As String

Dim oFileDialog as Object

Dim iAccept as Integer

Dim sPath as String

Dim InitPath as String

Dim RefControlName as String

Dim oUcb as object

'Dim ListAny(0)

'Note: The following services have to be called in the following order

' because otherwise does not remove the FileDialog Service

oFileDialog = CreateUnoService("com.sun.star.ui.dialogs.FilePicker")

oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")

'ListAny(0) = com.sun.star.ui.dialogs.TemplateDescription.FILEOPEN_SIMPLE

'oFileDialog.initialize(ListAny())

AddFiltersToDialog(FilterNames(), oFileDialog)

'Set your initial path here!

'InitPath = ConvertToUrl(oRefModel.Text)

If InitPath = "" Then

InitPath = GetPathSettings("Work")

End If

If oUcb.Exists(InitPath) Then

oFileDialog.SetDisplayDirectory(InitPath)

End If

iAccept = oFileDialog.Execute()

If iAccept = 1 Then

sPath = oFileDialog.Files(0)

GetAFileName = sPath

'If oUcb.Exists(sPath) Then

' oRefModel.Text = ConvertFromUrl(sPath)

'End If

End If

oFileDialog.Dispose()

End Function

Center a dialog on the screen

Thanks to Berend Cornelius [Berend.Cornelius@sun.com] for providing this macro. The primary trick is to use the current controller to finally retrieve the component window and from there to retrieve the position and size of the window.

Listing 8.7: Center a dialog on the screen.

Sub CenterDialogOnScreen

Dim CurPosSize As New com.sun.star.awt.Rectangle

FramePosSize = ThisComponent.getCurrentController().Frame.getComponentWindow.PosSize

xWindowPeer = oDialog.getPeer()

CurPosSize = oDialog.getPosSize()

WindowHeight = FramePosSize.Height

WindowWidth = FramePosSize.Width

DialogWidth = CurPosSize.Width

DialogHeight = CurPosSize.Height

iXPos = ((WindowWidth/2) - (DialogWidth/2))

iYPos = ((WindowHeight/2) - (DialogHeight/2))

oDialog.setPosSize(iXPos, iYPos, DialogWidth, DialogHeight, com.sun.star.awt.PosSize.POS)

oDialog.execute()

End Sub

Set the event listener for a control

The following little code snippet sets the event in a control to call the Test subroutine in the document standard library in the module named Module1. Thanks to Oliver Brinzing [OliverBrinzing@t-online.de] for the code.

Listing 8.8: Set the event listener for a control.

Sub SetEvent

Dim oDocument as Object

Dim oView as Object

Dim oDrawPage as Object

Dim oForm as Object

Dim oEvents(0) As New com.sun.star.script.ScriptEventDescriptor

oDocument = StarDesktop.getCurrentComponent

oView = oDocument.CurrentController

oDrawPage = oView.getActiveSheet.DrawPage

' get the first form

oForm = oDrawPage.getForms.getByIndex(0)

oEvents(0).ListenerType = "XActionListener"

oEvents(0).EventMethod = "actionPerformed"

oEvents(0).AddListenerParam = ""

oEvents(0).ScriptType = "StarBasic"

oEvents(0).ScriptCode = "document:Standard.Module1.Test"

oForm.registerScriptEvent(0, oEvents(0))

End Sub

Sub Test(oEvt)

Print oEvt.Source.Model.Name

End Sub

I suppose that a brief description on the registerScriptEvent method is in order. See http://api.openoffice.org/docs/common/ref/com/sun/star/script/XEventAttacherManager.html as a good starting point.

registerScriptEvent(index, ScriptEventDescriptor)

The oEvents variable is an array of event descriptors, see http://api.openoffice.org/docs/common/ref/com/sun/star/script/ScriptEventDescriptor.html, which describe the event that will be attached (EventMethod), and what it should call (ScriptCode). The above example could have just as easily used a single variable rather than an array, because the code only uses a single entry from the array. The first argument to the registerScriptEvent method is an index to the object that will “use” the event descriptor. The help pages assume that you know which objects are indexed and state that “If any object is attached under this index, then this event is attached automatically.” What it does not say is that the form acts as a container object for form components. These form components are available by name and by index.

Controlling a dialog I did not create.

Some dispatch commands load a dialog that you need to control. An interesting solution is presented by “ms777” on the oooforum: http://www.oooforum.org/forum/viewtopic.phtml?t=22845

Create a TopWindowListener.

Execute the dispatch.

The dispatch opens a new top window.

The top window listener is called.

Inside the top window listener, the accessibility interface is used to execute the desired user interactions.

Inside the top window listener, the dispatch dialog's OK Button is pressed to terminate the dispatch.

The TopWindowListener is removed.

There are a couple of caveats.

Do not attempt to use a breakpoint or perform other actions after creating the top window listener. The listener is trying to handle the input.

You need to understand the layout of the dialog that you wish to control. This is not an easy task, especially since you can not inspect the objects.

Inserting a formula

Figure 8.1: Insert an OLE object dialog.

Use the Insert OLE dialog to insert a Formula, or other object (see Figure 8.1). Manipulating the dialog requires that you know the objects that are inserted into the dialog so that you can access them. You also need to know how to interact with each object.

Table 8.1: Accessible content in the Insert OLE dialog.

Child	Name	Type
0	Create new	RADIO_BUTTON
1	Create from file	RADIO_BUTTON
2		PANEL
3	Object type	SEPARATOR
4	OK	PUSH_BUTTON
5	Cancel	PUSH_BUTTON
6	Help	PUSH_BUTTON

The macro in Listing 8.9 demonstrates how to use the Insert OLE dialog in Figure 8.1. The macro inserts an equation, and leaves the cursor in the insert equation mode (so it does not really set the equation).

Listing 8.9: Insert a formula into writer.

Sub InsertFormulaIntoWriter()

Dim oFrame ' Frame from the current window.

Dim oToolkit ' Container window's com.sun.star.awt.Toolkit

Dim oDisp ' Dispatch helper.

Dim oList ' XTopWindowListener that handles the interactions.

REM Get the com.sun.star.awt.Toolkit

oFrame = ThisComponent.getCurrentController().getFrame()

oToolkit = oFrame.getContainerWindow().getToolkit()

oList = createUnoListener("TopWFormula_", "com.sun.star.awt.XTopWindowListener")

oDisp = createUnoService("com.sun.star.frame.DispatchHelper")

REM Insert an OLE object!

oToolkit.addTopWindowListener(oList)

oDisp.executeDispatch(oFrame, ".uno:InsertObject", "", 0, Array())

oToolkit.removeTopWindowListener(oList)

End Sub

Sub TopWFormula_windowOpened(e As Object)

Dim oAC

Dim oACRadioButtonNew

Dim oACList

Dim oACButtonOK

REM Get the accessible window, which is the entire dialog.

oAC = e.source.AccessibleContext

REM Get the buttons

oACRadioButtonNew = oAC.getAccessibleChild(0).AccessibleContext

oACList = oAC.getAccessibleChild(2).AccessibleContext.getAccessibleChild(0)

oACButtonOK = oAC.getAccessibleChild(4).AccessibleContext

REM Select "Create New"

oACRadioButtonNew.doAccessibleAction(0)

REM Access the Fifth item in the list (as in 0, 1, 2, 3, 4...)

oACList.selectAccessibleChild(4)

REM The accessible action of a command button is to "use" it.

oACButtonOK.doAccessibleAction(0)

End Sub

Sub TopWFormula_windowClosing(e As Object)

End Sub

Sub TopWFormula_windowClosed(e As Object)

End Sub

Sub TopWFormula_windowMinimized(e As Object)

End Sub

Sub TopWFormula_windowNormalized(e As Object)

End Sub

Sub TopWFormula_windowActivated(e As Object)

End Sub

Sub TopWFormula_windowDeactivated(e As Object)

End Sub

Discovering the accessible content (by Andrew)

You can not directly inspect the objects so it is difficult to determine the accessible content so I wrote the macro in Listing 8.10. The macro inspects all of the child content and then prints its name and type. I did not spend much time worrying about error handling, so be warned.

Listing 8.10: Inspect the accessible content.

Function InspectAccessibleContent(sLead$, oAC) As String

REM Author Andrew Pitonyak

Dim x

Dim s$

Dim i%

Dim sL$

Dim oACUse

Dim oACChild

If HasUnoInterfaces(oAC, "com.sun.star.accessibility.XAccessibleContext") Then

oACUse = oAC

sL = sLead

ElseIf HasUnoInterfaces(oAC, "com.sun.star.accessibility.XAccessible") then

oACUse = oAC.AccessibleContext

sL = sLead & ".AC."

Else

Exit Function

End If

x = Array( "UNKNOWN", "ALERT", "COLUMN_HEADER", "CANVAS", "CHECK_BOX", _

"CHECK_MENU_ITEM", "COLOR_CHOOSER", "COMBO_BOX", "DATE_EDITOR", _

"DESKTOP_ICON", "DESKTOP_PANE", "DIRECTORY_PANE", "DIALOG", "DOCUMENT", _

"EMBEDDED_OBJECT", "END_NOTE", "FILE_CHOOSER", "FILLER", "FONT_CHOOSER", _

"FOOTER", "FOOTNOTE", "FRAME", "GLASS_PANE", "GRAPHIC", "GROUP_BOX", _

"HEADER", "HEADING", "HYPER_LINK", "ICON", "INTERNAL_FRAME", "LABEL", _

"LAYERED_PANE", "LIST", "LIST_ITEM", "MENU", "MENU_BAR", "MENU_ITEM", _

"OPTION_PANE", "PAGE_TAB", "PAGE_TAB_LIST", "PANEL", "PARAGRAPH", _

"PASSWORD_TEXT", "POPUP_MENU", "PUSH_BUTTON", "PROGRESS_BAR", _

"RADIO_BUTTON", "RADIO_MENU_ITEM", "ROW_HEADER", "ROOT_PANE", _

"SCROLL_BAR", "SCROLL_PANE", "SHAPE", "SEPARATOR", "SLIDER", "SPIN_BOX", _

"SPLIT_PANE", "STATUS_BAR", "TABLE", "TABLE_CELL", "TEXT", "TEXT_FRAME", _

"TOGGLE_BUTTON", "TOOL_BAR", "TOOL_TIP", "TREE", "VIEW_PORT", "WINDOW")

For i=0 to oACUse.AccessibleChildCount-1

oACChild = oACUse.getAccessibleChild(i)

If HasUnoInterfaces(oACChild, "com.sun.star.accessibility.XAccessibleContext") Then

s = s & sL & i & " " & oACChild.AccessibleName & " " & _

x(oACChild.AccessibleRole) & CHR$(10)

ElseIf HasUnoInterfaces(oACChild, "com.sun.star.accessibility.XAccessible") Then

oACChild = oACChild.AccessibleContext

s = s & sL & "AC." & i & " " & oACChild.AccessibleName & " " & _

x(oACChild.AccessibleRole) & CHR$(10)

Else

Exit Function ' unexpected situation, maybe caused by some intermediate state

End If

If oACChild.AccessibleRole = com.sun.star.accessibility.AccessibleRole.PANEL Then

s = s & InspectIt(sL & " " & x(oACChild.AccessibleRole) & ".", oACChild)

End If

Next

InspectIt = s

End Function

The Options dialog is very complicated, which makes it an excellent item to inspect. The code shown in Listing 8.11 is not complete. The code is modified from Listing 8.9; the required changes should be obvious. The code opens the Options dialog, and leaves it open. Information is displayed for whichever tab happens to be visible.

Listing 8.11: How to inspect the accessible content.

Option Explicit

Private sss$

Sub ManipulateOptions()

Dim oFrame ' Frame from the current window.

Dim oToolkit ' Container window's com.sun.star.awt.Toolkit

Dim oDisp ' Dispatch helper.

Dim oList ' XTopWindowListener that handles the interactions.

REM Get the com.sun.star.awt.Toolkit

oFrame = ThisComponent.getCurrentController().getFrame()

oToolkit = oFrame.getContainerWindow().getToolkit()

oList = createUnoListener("TopWFormula_", "com.sun.star.awt.XTopWindowListener")

oDisp = createUnoService("com.sun.star.frame.DispatchHelper")

oToolkit.addTopWindowListener(oList)

oDisp.executeDispatch(oFrame, ".uno:OptionsTreeDialog", "", 0, Array())

oToolkit.removeTopWindowListener(oList)

MsgBox sss

End Sub

Sub TopWFormula_windowOpened(e As Object)

sss = InspectIt("", e.source.AccessibleContext)

End Sub

Because of the complexity of some dialogs, ms777 wrote some search routines to find controls based on their name, type, or description. While searching, a delay is performed if the content is not found. When the dialog is manipulated, it is possible that the accessible content has not yet been updated to be displayed (so it might not exist).

Listing 8.12: Search for the specified child.

Function SearchOneSecForChild(oAC As Object, sName$, sDescription$, lRole As Long) As Object

Dim k%

Dim oRes

For k=1 To 50

oRes = SearchForChild(oAC, sName, sDescription, lRole)

If NOT IsNull(oRes) Then

SearchOneSecForChild = oRes

Exit Function

End If

Wait(20)

Next

End Function

Function SearchForChild(oAC As Object, sName$, sDescription$, lRole As Long) As Object

Dim oAC1

Dim oACChild

Dim k%

Dim bFound As Boolean

If HasUnoInterfaces(oAC, "com.sun.star.accessibility.XAccessibleContext") Then

oAC1 = oAC

ElseIf HasUnoInterfaces(oAC, "com.sun.star.accessibility.XAccessible") Then

oAC1 = oAC.AccessibleContext

Else

Exit Function ' unexpected situation, maybe caused by some intermediate state

End If

For k=0 To oAC.AccessibleChildCount-1

oACChild = oAC.getAccessibleChild(k)

If NOT HasUnoInterfaces(oACChild, "com.sun.star.accessibility.XAccessibleContext") Then

If HasUnoInterfaces(oACChild, "com.sun.star.accessibility.XAccessible") Then

oACChild = oACChild.AccessibleContext

Else

Exit Function ' unexpected situation, maybe caused by some intermediate state

End If

End If

bFound = true

If sName<>"" Then bFound = bFound AND (oACChild.AccessibleName = sName)

If sDescription<>"" Then bFound = bFound AND _

(oACChild.AccessibleDescription = sDescription)

If lRole > -1 Then bFound = bFound AND (oACChild.AccessibleRole = lRole)

If bFound Then

SearchForChild = oACChild

Exit Function

End If

Next

End Function

Manipulating the Options dialog

The Options dialog (Tools | Options) is very complicated, even more so by the fact that the dialog can be in any state. The following macro collapses all of the tree structures to place the dialog into a known state.

Listing 8.13: Collapse all of the trees in the options dialog.

Sub CollapseAllTrees(oAC)

REM Author ms777

REM Modified by Andrew Pitonyak

Dim oACChild

Dim oACChild1

Dim k%

Dim k1%

'make a defined state: collaps all items in all trees

For k=0 To oAC.getAccessibleChildCount-1

oACChild = oAC.getAccessibleChild(k)

If HasUnoInterfaces(oACChild, "com.sun.star.accessibility.XAccessibleContext") Then

If oACChild.AccessibleRole = com.sun.star.accessibility.AccessibleRole.TREE Then

For k1=0 To oACChild.getAccessibleChildCount-1

oACChild1 = oACChild.getAccessibleChild(k1)

If HasUnoInterfaces(oACChild1, "com.sun.star.accessibility.XAccessibleAction") Then

If oACChild1.AccessibleStateSet.contains(_

com.sun.star.accessibility.AccessibleStateType.EXPANDED) Then

oACChild1.doAccessibleAction(0)

End If

End If

Next k1

End If

End If

Next k

End Sub

Finally, after opening the Options dialog, you need to manipulate it.

Listing 8.14: Set the user's Title in the Options dialog.

Sub TopWFormula_windowOpened(e As Object)

Dim oAC

Dim oACTree

Dim oACOO

Dim oACButtonOK

Dim oACUserDataPanel

Dim oACTitle

Dim bResult As boolean

REM Get the accessible window, which is the entire dialog.

oAC = e.source.AccessibleContext

CollapseAllTrees(oAC)

'e.source.setVisible(false)

'Open up the tree item "OpenOffice.org"

oACTree = SearchOneSecForChild(oAC, "", "", _

com.sun.star.accessibility.AccessibleRole.TREE)

oACOO = SearchOneSecForChild(oACTree, "OpenOffice.org", "", _

com.sun.star.accessibility.AccessibleRole.LABEL)

oACOO.doAccessibleAction(0)

'Select the first entry in OpenOffice.org (UserData)

oACOO.selectAccessibleChild(0)

'now set the UserData

oACUserDataPanel = SearchOneSecForChild(oAC, "User Data", "", _

com.sun.star.accessibility.AccessibleRole.PANEL)

oACTitle = SearchOneSecForChild(oACUserDataPanel, "Title/Position", _

"Type your title in this field.", _

com.sun.star.accessibility.AccessibleRole.TEXT)

If NOT IsNULL(oACTitle) AND NOT IsEmpty(oACTitle) Then

bResult = oACTitle.setText("Meister aller Klassen")

EndIf

REM press the OK button

oACButtonOK = SearchOneSecForChild(oAC, "OK", "", _

com.sun.star.accessibility.AccessibleRole.PUSH_BUTTON)

oACButtonOK.doAccessibleAction(0)

End Sub

Listing the supported printers

This is one of my favorite examples presented by ms777. Get the list of all supported printers by displaying the print dialog, pulling the printer list from the dialog, and then canceling the dialog. The macro in Listing 8.15 requires the macro shown in Listing 8.12.

Listing 8.15: Get a list of all supported printers.

Option Explicit

Public GetPrinterArray735 As Any

Sub PrintAllPrinters

REM Author ms777.

Dim arPrinter

Dim s$

Dim k%

arPrinter = GetAllPrinters()

s = ""

For k = 0 To UBound(arPrinter)

s = s + k + ": " + arPrinter(k) +Chr(10)

Next k

MsgBox s

End Sub

Function GetAllPrinters() As Any

'On Error Resume Next

Dim oFrame ' Frame from the current window.

Dim oToolkit ' Container window's com.sun.star.awt.Toolkit

Dim oDisp ' Dispatch helper.

Dim oList ' XTopWindowListener that handles the interactions.

REM Get the com.sun.star.awt.Toolkit

oFrame = ThisComponent.getCurrentController().getFrame()

oToolkit = oFrame.getContainerWindow().getToolkit()

oList = createUnoListener("TopWPrint_", "com.sun.star.awt.XTopWindowListener")

oDisp = createUnoService("com.sun.star.frame.DispatchHelper")

oToolkit.addTopWindowListener(oList)

REM Insert an OLE object!

oDisp.executeDispatch(oFrame, ".uno:Print", "", 0, Array())

oToolkit.removeTopWindowListener(oList)

GetAllPrinters = GetPrinterArray735

End Function

Sub TopWPrint_windowOpened(e As Object)

Dim oAC

Dim oACComboBox

Dim oACList

Dim oACCancel

Dim k%

oAC = e.source.AccessibleContext

e.source.setVisible(false)

oACComboBox = SearchOneSecForChild(oAC, "", "", _

com.sun.star.accessibility.AccessibleRole.COMBO_BOX)

oACList = SearchOneSecForChild(oACComboBox, "", "", _

com.sun.star.accessibility.AccessibleRole.LIST)

oACCancel = SearchOneSecForChild(oAC, "Cancel", "", _

com.sun.star.accessibility.AccessibleRole.PUSH_BUTTON)

Dim sResult(oACList.AccessibleChildCount-1) As String

For k = 0 to oACList.AccessibleChildCount-1

sResult(k) = oACList.getAccessibleChild(k).AccessibleName

Next k

oACCancel.doAccessibleAction(0)

GetPrinterArray735 = sResult()

End Sub

Sub TopWPrint_windowClosing(e As Object)

End Sub

Sub TopWPrint_windowClosed(e As Object)

End Sub

Sub TopWPrint_windowMinimized(e As Object)

End Sub

Sub TopWPrint_windowNormalized(e As Object)

End Sub

Sub TopWPrint_windowActivated(e As Object)

End Sub

Sub TopWPrint_windowDeactivated(e As Object)

End Sub

Finding an open window

The following macro is presented by ms777 as part of his inspection routines. I felt that it was important enough to pull it out. The idea is that you open a dialog, notice the title, and then call this macro to obtain a reference to the window. This macro is used in

Listing 8.16: Find an open dialog based on its title.

'------------------- GetWindowOpen

REM Iterate through the open dialogs and find the one that starts with

REM sTitle.

Function GetWindowOpen(sTitle as String) As Object

Dim oToolkit

Dim lCount As Long

Dim k As Long

Dim oWin

oToolkit = Stardesktop.ActiveFrame.ContainerWindow.Toolkit

lCount = oToolkit.TopWindowCount

For k=0 To lCount -1

oWin = oToolkit.getTopWindow(k)

If HasUnoInterfaces(oWin, "com.sun.star.awt.XDialog") Then

If left(oWin.Title, len(sTitle)) = sTitle Then

GetWindowOpen = oWin

Exit Function

EndIf

EndIf

Next k

End Function

Inspecting accessible content (by ms777)

I wrote the macro in Listing 8.10 to inspect content. Ms777 then provided me with a macro that he wrote. I prefer his way. I did not know how to find an open window, as shown in Listing 8.16. The trick to using this next macro, is to first open the dialog, and then run the macro with name. I considered writing a dialog that allowed you to choose the window, but I do not have the time. I made minor modifications to declare every variable, and to provide some minor improvements in the displayed results.

Listing 8.17: Inspect the named dialog.

REM First, open the dialog that you want to inspect.

REM Next, run the following macro:

Sub InspectOpenWindow

Dim oWin

Dim oAC

'This Function identifies the top window, whose title starts with "Options"

'I used Tools | Options to open the window.

oWin = GetWindowOpen("Options")

oAC = oWin.AccessibleContext

'This generates a hierarchical list of the accessibility tree

call AnalyzeCreateSxc(oAC)

End Sub

'------------------- GetWindowOpen

REM Iterate through the open dialogs and find the one that starts with

REM sTitle.

Function GetWindowOpen(sTitle as String) As Object

Dim oToolkit

Dim lCount As Long

Dim k As Long

Dim oWin

oToolkit = Stardesktop.ActiveFrame.ContainerWindow.Toolkit

lCount = oToolkit.TopWindowCount

For k=0 To lCount -1

oWin = oToolkit.getTopWindow(k)

If HasUnoInterfaces(oWin, "com.sun.star.awt.XDialog") Then

If left(oWin.Title, len(sTitle)) = sTitle Then

GetWindowOpen = oWin

Exit Function

EndIf

EndIf

Next k

End Function

'------------------- AnalyzeCreateSxc

Sub AnalyzeCreateSxc(oAC As Object)

Dim kRowSheetOut As Long

Dim kColSheetOut as Long

Dim oDoc as Object

Dim oSheetOut

oDoc = StarDesktop.LoadComponentFromUrl("private:factory/scalc","_default",0,Array())

oSheetOut = oDoc.sheets.getByIndex(0)

kRowSheetOut = 0

kColSheetOut = 0

call Analyze(oAC, oSheetOut, kRowSheetOut, kColSheetOut, "")

End sub

Sub Analyze(oAC as Object, oSheetOut as Object, kRowSheetOut as Long, kColSheetOut as Long, sParentTrace as String)

Dim sName As String

Dim k As Long

Dim kMax As Integer

Dim lRole As Long

Dim sProps() As String

Dim sObjName As String

Dim k1 As Long

Dim k2 As Long

Dim kColSheetOut As Long

Dim oAC1

Dim oCell

Dim sTraceHelper As String

If HasUnoInterfaces(oAC, "com.sun.star.accessibility.XAccessibleContext") Then

oSheetOut.getCellByPosition(kColSheetOut, kRowSheetOut).String = _

AccessibleObjectDescriptionString(oAC) + " (" + sParentTrace + ")"

kRowSheetOut = kRowSheetOut + 1

kMax = -1

on error resume next

kMax = oAC.getAccessibleChildCount()-1

on error goto 0

' show maximum 30 childs

If kMax>=0 Then

If kMax>30 Then

k1 = 15

k2 = kMax-15

Else

k1=-1

k2=0

EndIf

For k=0 To k1

kColSheetOut = kColSheetOut + 1

sTraceHelper = IIF(Len(sParentTrace) = 0, "", ", ")

Call Analyze(oAC.getAccessibleChild(k), oSheetOut, kRowSheetOut, _

kColSheetOut, sParentTrace + sTraceHelper + k)

kColSheetOut = kColSheetOut - 1

Next k

For k=k2 To kMax

kColSheetOut = kColSheetOut + 1

sTraceHelper = IIF(Len(sParentTrace) = 0, "", ", ")

Call Analyze(oAC.getAccessibleChild(k), oSheetOut, kRowSheetOut, _

kColSheetOut, sParentTrace + sTraceHelper + k)

kColSheetOut = kColSheetOut - 1

Next k

EndIf

EndIf

If HasUnoInterfaces(oAC, "com.sun.star.accessibility.XAccessible") Then

oAC1 = oAC.AccessibleContext

If EqualUnoObjects(oAC1, oAC) Then

Exit Sub

EndIf

kColSheetOut = kColSheetOut + 1

Call Analyze(oAC1, oSheetOut, kRowSheetOut, kColSheetOut, sParentTrace + ", AC" )

kColSheetOut = kColSheetOut - 1

EndIf

End sub

Function AccessibleObjectDescriptionString(oAC As Object) As String

Dim s As String

Dim sText As String

Dim sProps()

Dim k As Long

Dim lRole As Long

Dim lActionCount As Long

s = ""

'AccessibleName

On Error Resume Next

sText = oAC.getAccessibleName()

On Error Goto 0

If sText ="" Then

sText = "--"

EndIf

s = s + sText

'AccessibleObject name

sProps = Split(oAC.Dbg_Properties,"""")

s = s + " " + sProps(1)

'AccessibleRole

lRole=-1

On Error Resume Next

lRole = oAC.getAccessibleRole()

On Error Goto 0

If lRole <>-1 Then

s = s + " Role: " + Choose(lRole+1, "UNKNOWN", "ALERT", "COLUMN_HEADER", "CANVAS", "CHECK_BOX", "CHECK_MENU_ITEM", "COLOR_CHOOSER", "COMBO_BOX", "DATE_EDITOR", "DESKTOP_ICON", "DESKTOP_PANE", "DIRECTORY_PANE", "DIALOG", "DOCUMENT", "EMBEDDED_OBJECT", "END_NOTE", "FILE_CHOOSER", "FILLER", "FONT_CHOOSER", "FOOTER", "FOOTNOTE", "FRAME", "GLASS_PANE", "GRAPHIC", "GROUP_BOX", "HEADER", "HEADING", "HYPER_LINK", "ICON", "INTERNAL_FRAME", "LABEL", "LAYERED_PANE", "LIST", "LIST_ITEM", "MENU", "MENU_BAR", "MENU_ITEM", "OPTION_PANE", "PAGE_TAB", "PAGE_TAB_LIST", "PANEL", "PARAGRAPH", "PASSWORD_TEXT", "POPUP_MENU", "PUSH_BUTTON", "PROGRESS_BAR", "RADIO_BUTTON", "RADIO_MENU_ITEM", "ROW_HEADER", "ROOT_PANE", "SCROLL_BAR", "SCROLL_PANE", "SHAPE", "SEPARATOR", "SLIDER", "SPIN_BOX", "SPLIT_PANE", "STATUS_BAR", "TABLE", "TABLE_CELL", "TEXT", "TEXT_FRAME", "TOGGLE_BUTTON", "TOOL_BAR", "TOOL_TIP", "TREE", "VIEW_PORT", "WINDOW")

EndIf

'AccessibleDescription

On Error Resume Next

s = s + " " + oAC.getAccessibleDescription()

On Error Goto 0

If HasUnoInterfaces(oAC, "com.sun.star.accessibility.XAccessibleAction") Then

s = s + " Actions:"

lActionCount = oAC.getAccessibleActionCount

For k=0 To lActionCount-1

s = s + " " + k + ": " + oAC.getAccessibleDescription(k)

Next k

EndIf

AccessibleObjectDescriptionString = s

End Function

Database

Some of the content is sketchy because it is from a project that I am not ready to share.

Available Resources

http://dba.openoffice.org The official OpenOffice database site.

http://www.oooforum.org/ Checkout the Data Sources forum.

http://www.math.umd.edu/~dcarrera/openoffice/docs/ Daniel Carrera's OpenOffice.org “User Guide” site. Numerous how-to documents are available here.

http://linux.bz/guides/ This includes many topics, including some database stuff.

http://user-faq.openoffice.org/#FAQ There are numerous faqs, including a database faq at http://user-faq.openoffice.org/faq/ar01s10.html, which contains some information and references the faq at the dba site.

http://www.MiniBooks.biz This provides resources that you can purchase.

http://documentation.openoffice.org/HOW_TO/ Excellent examples, including setting up a data source, and some good examples with tables (http://documentation.openoffice.org/HOW_TO/data_source/link_tablehtml/link.html).

http://homepage.ntlworld.com/garryknight/linux/oodbase.html Setting up some flat tables. Go through this!

OpenOffice.org defines an integrated database interface called Star Database Connectivity (SDBC). A driver that implements the SDBC interface is implemented as an UNO component for each database type supported by OpenOffice.org. There are two major advantages to this architecture. First, access is independent of the system and database in use. Second, new database types can be supported by developing a new driver.

Database server

A database server is software that assists in the storage and retrieval of information (from a database). The database is not necessarily stored on the computer (or computers) that run the database server. The server is responsible for updating and returning records, handling multiple simultaneous requests for authorized users, protecting data, and communicating with other servers that contain the actual data. The database server accepts queries, typically SQL, from multiple clients.

OpenOffice.org does not act as a database server. Examples of database servers include :

Adabas http://www.softwareag.com/corporat/solutions/datamanage/adabasd/default.htm

MySQL http://www.mysql.com

PostgreSQL http://www.postgresql.org

InterBase http://www.interbase2000.org

Oracle http://www.oracle.com

Information on numerous Linux databases is available (see http://linas.org/linux/db.html).

Database client

A database client is any program used to communicate with a database server. Each Client is designed to work with one or more specific database servers. In other words, a database client accesses and uses the data provided by a database server.

Database connection

A database connection refers to the connection mechanism between a database client and a database. Each database server implementation has its own query language idiosyncrasies, forcing a client to contain server specific code. A single client can support connections to numerous different server types and even support accessing certain data types directly – accessing a text file or Calc file, for example. In OpenOffice.org, a client will access a data source, which supports SDBC. The data source worries about the connection.

Data Source

A data source encapsulates both the data and the information required to connect to the data. In OpenOffice.org, a data source implements the SDBC interface and therefore hides most of the system specific details. OpenOffice.org implements data sources for the database types shown in Table 9.1.

Database	Comment
Adabas	StarOffice includes a slightly scaled down version of the Adabas database.
dBase	The dBase driver provides direct access to dBase files.
Text File	Text files, such as CSV files, provide read-only access.
Spreadsheet	Read-only access is provided for Calc and Excel documents.
JDBC	Connect to any database that supports Java Database Connectivity.
ODBC	Connect to any database that supports Open Database Connectivity.
ADO	ActiveX Data Objects is only supported on Windows.
Address Book	Read-only access to address books such as MAPI, LDAP, and even the Mozilla address book are supported.
Bibliography	?? I think that this is supported

Table 9.1. Database types supported by OpenOffice.org

SQL

SQL (Structured Query Language) is a standard interactive and programming language for retrieving information from and updating a database. Although SQL is both an ANSI and an ISO standard, most database products support proprietary extensions to the standard SQL language.

The SDBC interface supports a SQL version the is close to the ANSI standard. If a data source references a database that does not directly support SQL, then the data source must implement SQL to access the underlying data.

Connect to a data source and get a value from a table

The following macro is a complete working example. You will need to read the code to determine the assumptions. For example, that the data source is named “datasource”, the user “oouser”, and the password is “mypass”. The original macro is take from the following link: http://blog.magenson.de/archives/34_OpenOffice+data+access+macro.html

'Author: Frédéric Wenzel

'Email: fwenzel@gmx.net

'Macro is licensed under the GNU GPL:

'http://www.gnu.org/licenses/gpl.txt

'Data access macro for OpenOffice.org / StarOffice.

'-- version 0.1 --

'Searches a specific data source for a row matching the given primary key number

'and then returns the value of the given column (field).

'Known issues:

'- providing the password here is quite unsafe. Think of alternatives.

'- error handling could be more verbose.

'- SQL select statement is quite MySQL specific. Needs to be rewritten to meet other DBMSes.

function dbSelect(table As String, idNumber As String, fieldName As String, _

Optional idField As String) as String

Dim oDatabase as Object

Dim oConnection as Object

Dim oStatement as Object

Dim oResultSet as Object

'**** Set up things here ****

Const dataSourceName as String = "datasource" 'OpenOffice data source to connect to

Const dbUser as String = "oouser" 'username for data source

'CAUTION: Use an unprivileged user here as using a privileged password

'is a severe security risk!

'password for data source

Const dbPass as String = "mypass"

'Default (unique) primary key field to be searched if none is given

Const idFieldDef as String = "id"

'**** End of Setup ****

'some error handling

On Error Goto ErrorHandler

'Set default primary key row:

If isMissing(idField) Then idField = idFieldDef

oDatabase = CreateUnoService("com.sun.star.sdb.DatabaseContext")

oConnection= oDatabase.GetByName(dataSourceName).GetConnection(dbUser, dbPass)

oStatement = oConnection.createStatement()

oResultSet = oStatement.executeQuery("SELECT `" & idField & "`, `" & fieldName & _

"` FROM `" & table & "` WHERE `" & idField & "` = '" & idNumber & "' LIMIT 1;")

If Not IsNull(oResultSet) Then

oResultSet.next

'now return selected value if resultset is not empty

If Not oResultSet.isAfterLast() Then dbSelect = oResultSet.getString(2)

Exit Function

End If

'otherwise: return empty string

dbSelect = ""

Exit Function

'*****

'minor error handling

ErrorHandler:

dbSelect = "## Error! ##"

End Function

Investment Example

??Do not translate this yet!?? I will probably delete this!

I have been tracking my investments, modest as they are, in a spreadsheet for quite some time. I decided that it was time for a change.

Summary Page

I have a summary page with a row for each investment. My initial thoughts were that I wanted the following information:

Column	Description
Owner	Who owns this account? Me, my wife, etc.
NASDAQ	I want to automate the determination of the current value. To do this, I require the NASDAQ symbol. I will write a macro to do this.
Date	What was the last time I automatically updated the price.
Price	Current price on the NASDAQ.
Shares	Number of shares that I own. This is taken from the detail sheet.
Worth	Current value of this investment. This is “Price * Shares”
Type	My currently used values include “stock”, “fund”, and “Bank”.
Sub Type	I currently have values such as “Mid Cap” to provide a little more information about the investment.
What	When I created this column, I was thinking things such as “Roth”, “IRA”, “investment”, “401K”, “checking”, etc.
Open	Date I opened the account
Name	The name that identifies the account. Typically I use the name used by the owning institution such as “Long Term Tax Exempt”.
Company	This is the name of the owning institution such as “Vanguard”, “Thrivent”, or “T. Rowe Price”.
Account	My account number
Sheet Name	The name of the sheet containing the account details.
Beneficiary	Who becomes the owner of the account if the current owner dies.

Detail Sheet

I assumed that if each detail sheet looked the same, this would make it easier to perform automated operations on the sheet. I do not know much about investing or finance so I make no promises on how useful my choices are. I decided on the following columns:

Column	Description
Worth	Current value of this investment. This is “Price * Shares”
Shares	Number of shares that I own.
$ I Added	How much I spent on this transaction.
# I Added	Shares purchased by my contribution.
# Match	Shares purchased by a matching program such as a 401K match.
# Divided	Shares added as a dividend.
# Fee	Shares removed because of a fee of some sort.
Price/Share	Amount paid for each share.
Date	Transaction date.
$ Spent	Cumulative amount I have spent on this investment.
Yield	When I open a bank account, there is usually an associated interest rate. I wanted some means of determining how well my account has performed so I try to calculate some sort of average yield.
Comment	I add comments such as “$2.50 maintenance fee.”

Check A Column For Duplicates

To prevent two investments from using the same sheet name, I required a macro to search the “Sheet Name” column for duplicate entries. A few utility macros are required to do this.

'Given a cell, extract the normal looking address of a cell

'First, the name of the containing sheet is extracted.

'Second, the column number is obtained and turned into a letter

'Lastly, the row is obtained. Rows start at 0 but are displayed as 1

Function PrintableAddressOfCell(the_cell As Object) As String

PrintableAddressOfCell = "Unknown"

If Not IsNull(the_cell) Then

PrintableAddressOfCell = the_cell.getSpreadSheet().getName + _

":" + ColumnNumberToString(the_cell.CellAddress.Column) + _

(the_cell.CellAddress.Row + 1)

End If

End Function

Printable Cell Address From Cell

Problems traceable to a cell are best reported in an easy to digest format. Internally, columns are numbered 0 to 255. The columns are reported from 'A' to 'IV'. For the mathematically inclined, the problem is to convert from base 10 to base 26 where 0 maps to A and 25 maps to Z.

' Columns are numbered 0 to 255, and shows from 'A' to 'IV'

' How do you convert Base 10 numbers to Base 26?

Function ColumnNumberToString(the_column As Long) As String

Dim s$

Do

s$ = Chr(65 + the_column MOD 26) + s$

'If I don't use Int, then it seems to round

'the result rather than truncating.

the_column = Int(the_column / 26)

Loop Until the_column = 0

ColumnNumberToString = s$

End Function

To print an entire address from a cell, a little more work is required. The sheet name is easily obtained. The column name is described above. Rows are internally represented as starting from 0 and externally represented starting from 1.

'Return a normal looking cell address as 'Sheetname'.ColumnRow.

'Rows start at 0 but are displayed as 1

Function PrintableCellAddress(the_cell As Object) As String

PrintableAddressOfCell = "Unknown"

If Not IsNull(the_cell) Then

PrintableAddressOfCell = "'" + the_cell.getSpreadSheet().getName + _

"'." + ColumnNumberToString(the_cell.CellAddress.Column) + _

(the_cell.CellAddress.Row + 1)

End If

End Function

Count Non-Empty Entries In Column

'oSheet Spreadsheet containing the column

'lCol Column to check

'l_min Ignore rows before this

'l_max Ignore columns after this

'Return the number of non-blank cells in the column

'I used the variant type in the parameter to avoid a bug in version 1.0.2

'That fails to properly detect Optional parameters with non-variant types.

Function NonBlankCellsInColumn (oSheet As Object, lCol&, _

Optional l_min As Variant, Optional l_max As Variant) As Long

Dim oCells As Object, oCell As Object, oColumn As Object

Dim oAddr As Object, oRanges As Object

Dim n&, lMin&, lMax&

n = 0

lMin = 0

lMax = 2147483647

If Not IsMissing(l_min) Then lMin = l_min

If Not IsMissing(l_max) Then lMax = l_max

oColumn = oSheet.Columns(lCol)

oRanges = ThisComponent.createInstance("com.sun.star.sheet.SheetCellRanges")

oRanges.insertByName("", oColumn)

oCells = oRanges.Cells.createEnumeration

Do While oCells.hasMoreElements

oCell = oCells.nextElement

oAddr = oCell.CellAddress

If oAddr.Row > lMax Then Exit Do

If oAddr.Row >= lMin AND Len(oCell.String) > 0 Then n=n+1

Loop

NonBlankCellsInColumn = n

End Function

Sorted Array

I am not overly concerned about efficiency because the number of elements in my arrays are small. Because of this, I use a modified bubble sort.

'sArray holds the sorted array

'oSheet Spreadsheet containing the column

'lCol Column to check

'l_min Ignore rows before this

'l_max Ignore columns after this

Sub BuildSortedArray (sArray() As String, oSheet As Object, lCol&, _

Optional l_min As Variant, Optional l_max As Variant)

Dim oCells As Object, oCell As Object, oColumn As Object

Dim oAddr As Object, oRanges As Object

Dim n&, i&, j&, lMin&, lMax&

n = NonBlankCellsInColumn (oSheet, lCol&,l_min,l_max)

If n = 0 Then

ReDim sArray() As String

Else

ReDim sArray(n-1) As String

lMin = 0

lMax = 2147483647

If Not IsMissing(l_min) Then lMin = l_min

If Not IsMissing(l_max) Then lMax = l_max

oColumn = oSheet.Columns(lCol)

oRanges = ThisComponent.createInstance("com.sun.star.sheet.SheetCellRanges")

oRanges.insertByName("", oColumn)

oCells = oRanges.Cells.createEnumeration

i = 0

Do While oCells.hasMoreElements

oCell = oCells.nextElement

oAddr = oCell.CellAddress

If oAddr.Row > lMax Then Exit Do

If oAddr.Row >= lMin AND Len(oCell.String) > 0 Then

sArray(i) = oCell.String

i = i + 1

End If

Loop

Dim bSomethingChanged As Boolean

Dim sTemp$

For i = LBound(sArray()) To UBound(sArray()) - 2

bSomethingChanged = False

For j = n-1 To i+1 Step -1

If sArray(j) < sArray(j-1) Then

sTemp$ = sArray(j)

sArray(j) = sArray(j-1)

sArray(j-1) = sTemp$

bSomethingChanged = True

End If

Next

If Not bSomethingChanged Then Exit For

Next

End If

End Sub

Find The Duplicate

With a sorted array, it is easy to find a duplicate entry! I search for the first one and return it.

Function FirstDuplicate(sArray() As String) As String

Dim i&

FirstDuplicate = ""

For i = LBound(sArray()) To UBound(sArray()) - 1

If sArray(i) = sArray(i+1) Then

FirstDuplicate = sArray(i)

Exit For

End If

Next

End Function

Handlers and Listeners

A handler, for the sake of this chapter, is any code that uses a call back or is somehow related to handling some sort of event.

XKeyHandler

This handler example is provided by Leston Buell [bulbul@ucla.edu]. His description of the code is as follows:

Reduced Compose Macro Description

Invoke “Compose” and type a two-letter combination from:

Ch, ch, Gh, gh, Hh, hh, Jh, jh, Sh, sh, Uh, uh

These, respectively insert the following Esperanto characters in the document:

Ĉ, ĉ, Ĝ, ĝ, Ĥ, ĥ, Ĵ, ĵ, Ŝ, ŝ, Ŭ, ŭ

Note: not many fonts have these characters.

Leston's Comments

Leston's comments with only minor modification: I'm a Java/Python/Javascript person and know little about . This should be rewritten to be more modular and extensible. For example, it should be able to load different mappings such as one each for Latin, Hebrew, Cyrillic, and mathematical symbols. The mappings should be arrays rather than the long select case method that I use. That way you could do generate a table of the mappings on the fly. It should also be modified to work in more than just text documents.

That said, the macro works and satisfies my current needs. This document contains a pared down version, which only has the characters needed for Esperanto. The real version, which at some point I'll make available on the web, supports all of the non-ASCII alphabetic characters of Latin1, ExtendedLatinA, and ExtendedLatinB, plus other conveniences like French quotation marks and the Euro symbol.

To use this macro, invoke "Compose" and type one of the character combinations: "Gh", "gh", "^J", "uh" - or any of other combination shown in the GetTranslation function. The corresponding Unicode character is inserted into the document. The KeyHandler unregisters itself after two key strokes regardless of whether a translation is found.

I (Leston) assign Compose to Ctrl+H, which makes for easy typing. (Andrew's note: you could also map it to other keys to support key mappings such as word star control keys)

I do not understand scope in , so I use all global variables at the top. If this isn't the best way to do this, feel free to change it.(Andrew's note: This could cause unexpected problems) I think the macro exposes a bug in key events. This bug is noted in the comment in the InsertString function.

Implementation

When the complete version is made available, I will either host it myself or provide a link.

REM Author:Leston Buell [bulbul@ucla.edu]

Global oComposerDocView

Global oComposerKeyHandler

Global oComposerInputString

Sub Compose

oComposerDocView = ThisComponent.getCurrentController

oComposerKeyHandler = createUnoListener( "Composer_", _

"com.sun.star.awt.XKeyHandler" )

oComposerDocView.addKeyHandler( oComposerKeyHandler )

oComposerInputString = ""

End Sub

Sub ExitCompose

oComposerDocView.removeKeyHandler( oComposerKeyHandler )

oComposerInputString = ""

End Sub

Function InsertString( oString, oDocView, oKeyHandler )

Dim oViewCursor

Dim oText

Dim oCursor

oViewCursor = ThisComponent.getCurrentController().getViewCursor()

oText = ThisComponent.getText()

oCursor = oText.createTextCursorByRange( oViewCursor.getStart() )

'For some reason, the text insertion refires the key events (twice!),

'so we remove the handler before insertion, then re-add it afterwards.

oDocView.removeKeyHandler( oKeyHandler )

oText.insertString( oCursor.getStart(), oString, true )

oDocView.addKeyHandler( oKeyHandler )

End Function

Function Composer_keyPressed( oEvt ) as Boolean

If len( oComposerInputString ) = 1 Then

oComposerInputString = oComposerInputString & oEvt.KeyChar

Dim translation

translation = GetTranslation( oComposerInputString )

InsertString( translation, oComposerDocView, oComposerKeyHandler )

oComposerInputString = ""

ExitCompose

Else

oComposerInputString = oComposerInputString & oEvt.KeyChar

End If

Composer_KeyPressed = True

End Function

Function Composer_keyReleased( oEvt ) as Boolean

Composer_keyReleased = False

End Function

Function GetTranslation( oString ) as String

Select Case oString

Case "^C", "Ch"

GetTranslation = "Ĉ"

Case "^c", "ch"

GetTranslation = "ĉ"

Case "^G", "Gh"

GetTranslation = "Ĝ"

Case "^g", "gh"

GetTranslation = "ĝ"

Case "^H", "Hh"

GetTranslation = "Ĥ"

Case "^h", "hh"

GetTranslation = "ĥ"

Case "^J", "Jh"

GetTranslation = "Ĵ"

Case "^j", "jh"

GetTranslation = "ĵ"

Case "^S", "Sh"

GetTranslation = "Ŝ"

Case "^s", "sh"

GetTranslation = "ŝ"

Case "uU", "Uh"

GetTranslation = "Ŭ"

Case "uu", "uh"

GetTranslation = "ŭ"

End Select

End Function

Listener Write-Up by Paolo Mantovani

The text in this next section was written by Paolo Mantovani. I (Andrew Pitonyak) made a few minor modifications, but have made no attempt to verify the material. That said, I can vouch for Paolo as an extremely reliable source. Thank you Paolo for taking the time. This is one of the best write-ups that I have seen on the topic. The document contained the following disclaimer when I received it and I include it here as well!

© 2003 Paolo Mantovani

This document is released under the Public Documentation License Version 1.0

A copy of the License is available at http://www.openoffice.org/licenses/pdl.pdf

The CreateUnoListener function

The OOo Basic runtime environment provides a function called CreateUnoListener. This functions takes two arguments: a prefix (String) and a fully qualified name of a listener interface (String). This is the syntax

oListener = CreateUnoListener( sPrefix , sInterfaceName )

Since the 1.1 version this function is described very well in the OOo Basic help, but we would add some thoughts about it. Consider the following code:

oListener = CreateUnoListener("prefix_", "com.sun.star.lang.XEventListener")

MsgBox oListener.Dbg_supportedInterfaces

MsgBox oListener.Dbg_methods

The com.sun.star.lang.XEventListener interface is the base interface for any other listener, therefore it's the simplest listener you can find. Notice that this interface works only as a base interface for other listeners, so you should not use it explicitly, but for this example it works very well.

Nice, but what does it do?

OOo Basic macros are able to call API methods and properties. Usually a macro makes many API calls. On the other hand, API's are usually not able to call OOo Basic routines. Consider the following example:

Sub Example_Listener

oListener = CreateUnoListener("prefix_", "com.sun.star.lang.XEventListener")

Dim oArg As New com.sun.star.lang.EventObject

oListener.disposing( oArgument )

End Sub

Sub prefix_disposing( vArgument )

MsgBox "Hi all!!"

End Sub

When the first routine calls “oListener.disposing()”, the prefix_disposing routine is called. Therefore, the CreateUnoListener function creates a service able to call your OOo Basic procedures.

You must create subroutines and functions with names that match the names of the listener's method, with the addition of the prefix specified when you call CreateUnoListener. For example, the call to CreateUnoListener passes the first argument as “prefix_” and the subroutine “prefix_disposing” starts with “prefix_”.

The documentation for the com.sun.star.lang.XEventListener interface says that the argument must be a com.sun.star.lang.EventObject structure.

Quite useless, but tell me more...

Although this is not the best way to call one macro from another, UNO requires a listener to call your macros. When you want to use a listener to intercept events, you require an UNO object able to speak to your listener. The UNO object that calls your listener is called a broadcaster. UNO broadcaster objects support methods to add and remove the appropriate listeners.

To create a listener object, pass the fully qualified name of the listener interface to the CreateUnoListener function. Retrieve the methods supported by the listener by accessing the Dbg_methods property (or check the IDL documentation for the listener interface). Finally, implement a basic routine for each method; even the disposing method.

Many UNO services provides methods to register and unregister listeners. For example, the com.sun.star.OfficeDocumentView service supports the com.sun.star.view.XSelectionSupplier interface. This is the broadcaster. This interface provides the following methods:

addSelectionChangeListener

registers an event listener, which is called when the selection changes.

removeSelectionChangeListener

unregisters an event listener which was registered with addSelectionChangeListener

Both methods take a SelectionChangeListener as an argument (that is an UNO service that supports the com.sun.star.view.XSelectionChangeListener interface)

The broadcaster object puts one or more arguments in the callee. The first argument is an UNO structure, the following are depending on the interface definition. Check the IDL documentation of the listener interface you're using and see the method's detail. Often, the structure passed is a com.sun.star.lang.EventObject. However, all event structures must extend the com.sun.star.lang.EventObject, so they have at least the source element.

Example 1: com.sun.star.view.XSelectionChangeListener

Following is a complete implementation of the selection change listener. This listener can be used with all OpenOffice.org documents.

Option Explicit

Global oListener As Object

Global oDocView As Object

'run this macro to start event intercepting

Sub Example_SelectionChangeListener

oDocView = ThisComponent.getCurrentController

'create a listener to intercept the selection change event

oListener = CreateUnoListener( "MyApp_", "com.sun.star.view.XSelectionChangeListener" )

' register the listener to the document controller

oDocView.addSelectionChangeListener(oListener)

End Sub

'run this macro to stop event intercepting

Sub Remove_Listener

' removes the listener

oDocView.removeSelectionChangeListener(oListener)

End Sub

'all listeners must support this event

Sub MyApp_disposing(oEvent)

msgbox "disposing the listener"

End Sub

Sub MyApp_selectionChanged(oEvent)

Dim oCurrentSelection As Object

'the source property of the event struct

'gets a reference to the current selection

oCurrentSelection = oEvent.source

MsgBox oCurrentSelection.dbg_properties

End Sub

Notice that all listener's methods must be implemented in your basic program because if the caller service doesn't find the appropriate routines, a runtime error is raised.

Related API references:
http://api.openoffice.org/docs/common/ref/com/sun/star/view/OfficeDocumentView.html
http://api.openoffice.org/docs/common/ref/com/sun/star/view/XSelectionSupplier.html
http://api.openoffice.org/docs/common/ref/com/sun/star/view/XSelectionChangeListener.html
http://api.openoffice.org/docs/common/ref/com/sun/star/lang/EventObject.html

Example 2: com.sun.star.view.XPrintJobListener

An object that can be printed (let's say a document object), may support the com.sun.star.view.XPrintJobBroadcaster interface. This interface allows you to register (and unregister) a com.sun.star.view.XPrintJobListener to intercept events while printing. When you intercept printing events, you get a com.sun.star.view.PrintJobEvent structure. This structure has the usual property “source”; the source of this event is a Print Job, that is a service that describes the current printing process and must support the com.sun.star.view.XPrintJob interface.

Option Explicit

Global oPrintJobListener As Object

'run this macro to start event intercepting

Sub Register_PrintJobListener

oPrintJobListener = _

CreateUnoListener("MyApp_", "com.sun.star.view.XPrintJobListener")

'this function is defined in the "Tools" Library

'writedbginfo oPrintJobListener

ThisComponent.addPrintJobListener(oPrintJobListener)

End Sub

'run this macro to stop event intercepting

Sub Unregister_PrintJobListener

ThisComponent.removePrintJobListener(oPrintJobListener)

End Sub

'all listeners must support this event

Sub MyApp_disposing(oEvent)

'nothing to do here

End sub

'this event is called several times

'during the printing process

Sub MyApp_printJobEvent(oEvent)

'the source of the printJob event is a PrintJob,

'that is a service that supports the com.sun.star.view.XPrintJob

'interface.

'This service describes the current printing process.

MsgBox oEvent.source.Dbg_methods

Select Case oEvent.State

Case com.sun.star.view.PrintableState.JOB_STARTED

Msgbox "printing (rendering the document) has begun"

Case com.sun.star.view.PrintableState.JOB_COMPLETED

sMsg = "printing (rendering the document) "

sMsg = sMsg & "has finished, spooling has begun"

Msgbox sMsg

Case com.sun.star.view.PrintableState.JOB_SPOOLED

sMsg = "spooling has finished successfully."

sMsg = sMsg & " This is the only state that "

sMsg = sMsg & "can be considered as 'success'"

sMsg = sMsg & "for a print job."

Msgbox sMsg

Case com.sun.star.view.PrintableState.JOB_ABORTED

sMsg = "printing was aborted (e.g., by the user) "

sMsg = sMsg & "while either printing or spooling."

Msgbox sMsg

Case com.sun.star.view.PrintableState.JOB_FAILED

sMsg = "printing ran into an error."

Msgbox sMsg

Case com.sun.star.view.PrintableState.JOB_SPOOLING_FAILED

sMsg = "the document could be printed but not spooled."

Msgbox sMsg

End Select

End sub

Related API references:
http://api.openoffice.org/docs/common/ref/com/sun/star/document/OfficeDocument.html
http://api.openoffice.org/docs/common/ref/com/sun/star/view/XPrintJobBroadcaster.html
http://api.openoffice.org/docs/common/ref/com/sun/star/view/XPrintJobListener.html
http://api.openoffice.org/docs/common/ref/com/sun/star/view/PrintJobEvent.html
http://api.openoffice.org/docs/common/ref/com/sun/star/view/XPrintJob.html

Example 3: com.sun.star.awt.XKeyHandler

Handlers are a special type of listener. As listeners they can intercept an event, but in addition an handler acts as event consumer, in other words, an handler can “eat” the event. In difference to listeners, methods in handlers must get a result (boolean): a True result tells to broadcaster that the event is consumed from the handler, this causes that broadcaster will not send the event to the rest of the handlers.

The com.sun.star.awt.XKeyHandler allows to intercept key events into a document. The example shows a key handler that acts as consumer for some key pressed events (keys “t”, “a”, “b”, “u”) :

Option Explicit

Global oDocView

Global oKeyHandler

Sub RegisterKeyHandler

oDocView = ThisComponent.getCurrentController

oKeyHandler = _

createUnoListener("MyApp_", "com.sun.star.awt.XKeyHandler")

' writedbginfo oKeyHandler

oDocView.addKeyHandler(oKeyHandler)

End Sub

Sub UnregisterKeyHandler

oDocView.removeKeyHandler(oKeyHandler)

End Sub

Sub MyApp_disposing(oEvt)

'nothing to do here

End Sub

Function MyApp_KeyPressed(oEvt) As Boolean

select case oEvt.KeyChar

case "t", "a", "b", "u"

MyApp_KeyPressed = True

msgbox "key """ & oEvt.KeyChar & """ not allowed!"

case else

MyApp_KeyPressed = False

end select

End Function

Function MyApp_KeyReleased(oEvt) As Boolean

MyApp_KeyReleased = False

End Function

Related API references:
http://api.openoffice.org/docs/common/ref/com/sun/star/awt/XUserInputInterception.html
http://api.openoffice.org/docs/common/ref/com/sun/star/awt/XExtendedToolkit.html
http://api.openoffice.org/docs/common/ref/com/sun/star/awt/XKeyHandler.html
http://api.openoffice.org/docs/common/ref/com/sun/star/awt/KeyEvent.html
http://api.openoffice.org/docs/common/ref/com/sun/star/awt/Key.html
http://api.openoffice.org/docs/common/ref/com/sun/star/awt/KeyFunction.html
http://api.openoffice.org/docs/common/ref/com/sun/star/awt/KeyModifier.html
http://api.openoffice.org/docs/common/ref/com/sun/star/awt/InputEvent.html

Andrew has a little something to add

The question came up, how can I intercept F1 or Alt+z. The KeyChar for the function keys have an ASCII value of zero. Check the KeyCode for special characters. Although I do not see it mentioned elsewhere, you should also check the MODIFIERS property to make certain that the control, alt, and shift keys are NOT used. In the following example, I compare directly to the MOD2 key modifier even though this is only a flag. I only want to trap Alt+z, not Ctrl+Alt+z or any other variant.

If oEvt.KeyCode = com.sun.star.awt.Key.F1 AND oEvt.MODIFIERS = 0 Then

MsgBox "Ha ha, I will NOT allow you to use F1 today!"

MyApp_KeyPressed = True

Exit Function

End If

If oEvt.KeyChar = "z" AND oEvt.MODIFIERS = com.sun.star.awt.KeyModifier.MOD2 Then

MsgBox "Ha ha, I will NOT allow you to use Alt+z today!"

MyApp_KeyPressed = True

Exit Function

End If

Unfortunately, this code can fail to find Alt+z. If the caps lock is pressed, then shift+z returns “z” rather than “Z” and the modifier will have both MOD2 and MOD1. The following example traps Alt+z even when caps lock is used.

If oEvt.KeyChar = "z" AND _

((oEvt.MODIFIERS AND com.sun.star.awt.KeyModifier.MOD2) <> 0) AND _

((oEvt.MODIFIERS AND com.sun.star.awt.KeyModifier.MOD1) = 0) Then

MsgBox "Ha ha, I will NOT allow you to use Alt+z today!"

MyApp_KeyPressed = True

Exit Function

End If

Example 4: com.sun.star.awt.XMouseClickHandler

This handler allows to intercept mouse clicks in a document. The example shows a complete implementation of this handler:

Option Explicit

Global oDocView As Object

Global oMouseClickHandler As Object

Sub RegisterMouseClickHandler

oDocView = ThisComponent.currentController

oMouseClickHandler = _

createUnoListener("MyApp_", "com.sun.star.awt.XMouseClickHandler")

' writedbginfo oMouseClickHandler

oDocView.addMouseClickHandler(oMouseClickHandler)

End Sub

Sub UnregisterMouseClickHandler

on error resume next

oDocView.removeMouseClickHandler(oMouseClickHandler)

on error goto 0

End Sub

Sub MyApp_disposing(oEvt)

End Sub

Function MyApp_mousePressed(oEvt) As Boolean

MyApp_mousePressed = False

End Function

Function MyApp_mouseReleased(oEvt) As Boolean

Dim sMsg As String

With oEvt

sMsg = sMsg & "Modifiers = " & .Modifiers & Chr(10)

sMsg = sMsg & "Buttons = " & .Buttons & Chr(10)

sMsg = sMsg & "X = " & .X & Chr(10)

sMsg = sMsg & "Y = " & .Y & Chr(10)

sMsg = sMsg & "ClickCount = " & .ClickCount & Chr(10)

sMsg = sMsg & "PopupTrigger = " & .PopupTrigger '& Chr(10)

'sMsg = sMsg & .Source.dbg_Methods

End With

ThisComponent.text.string = sMsg

MyApp_mouseReleased = False

End Function

Related API references:
http://api.openoffice.org/docs/common/ref/com/sun/star/awt/XUserInputInterception.html
http://api.openoffice.org/docs/common/ref/com/sun/star/awt/XMouseClickHandler.html
http://api.openoffice.org/docs/common/ref/com/sun/star/awt/MouseEvent.html
http://api.openoffice.org/docs/common/ref/com/sun/star/awt/MouseButton.html
http://api.openoffice.org/docs/common/ref/com/sun/star/awt/InputEvent.html

Example 5: Manual binding of events

Normally, programming in OOo Basic, you don't need listeners, because you can manually bind an event to a macro. For example, from the dialog “Configure” (menu “Tools”=>”Configure..”), selecting the “events” tab you can bind application events or document events. Furthermore, many objects that you can insert into a document offer a properties-dialog with a Tab “Events”. Finally, OOo Basic dialogs and controls have this as well.

It's useful to notice that in the manual binding, the underlying mechanism is the same as listeners, therefore, you can add an event parameter to your macros to get additional information about the event.

To run the following example, open a new Writer document, add a Text Edit control and manually assign the macro to the key pressed event of the control. Notice that the macro name and the event name are arbitrary.

Option Explicit

' This macro is manually assigned to the key-pressed

' event of a text-edit control in the document.

Sub MyTextEdit_KeyPressed(oEvt)

Dim sMsg As String

With oEvt

sMsg = sMsg & "Modifiers = " & .Modifiers & Chr(10)

sMsg = sMsg & "KeyCode = " & .KeyCode & Chr(10)

sMsg = sMsg & "KeyChar = " & .KeyChar & Chr(10)

sMsg = sMsg & "KeyFunc = " & .KeyFunc & Chr(10)

sMsg = sMsg & .Source.Dbg_supportedInterfaces

End With

msgbox sMsg

End Sub

What happened to my ActiveSheet listener?

Jim Thompson provided the code fragment to create an Event Listener for changes to the "ActiveSheet" property in the current controller. The listener notices when a new sheet is selected in the same document and performs sheet-specific processing. Activating and deactivating page preview (File | Page Preview), however, disables the listener so a change to a new sheet is no longer detected. The following code acts as the listener and does not demonstrate the solution:

REM Author: Jim Thompson

REM Email: jimthompson5802@aol.com

Global oActiveSheetListener as Object

Global CurrentWorksheetName as String

Global oListeningController as Object

Sub Workbook_Open()

Rem Workbook_Open procedure assigned to "Document Open" event

Rem Activate various listeners for events during processing

Rem Turn-on worksheet activation listener

Call WorksheetActivationListenerOn

End Sub

Sub WorksheetActivationListenerOn

CurrentWorksheetName = ""

oListeningController = ThisComponent.CurrentController

oActiveSheetListener = _

createUnoListener("ACTIVESHEET_","com.sun.star.beans.XPropertyChangeListener")

oListeningController.addPropertyChangeListener("ActiveSheet", oActiveSheetListener)

End Sub

Sub WorksheetActivationListenerOff

oListeningController.removePropertyChangeListener("ActiveSheet", oActiveSheetListener)

End Sub

Sub ACTIVESHEET_propertyChange(oEvent)

REM call appropriate worksheet deactivation procedure

Select Case CurrentWorksheetName

Case "Example5"

Call Example5Code.Worksheet_Deactivate

End select

REM msgbox "sheet changed: OldSheet =" & CurrentWorksheetName & ", NewSheet=" & _

REM oEvent.Source.ActiveSheet.Name

REM call appropriate worksheet activation procedure

Select case oEvent.Source.ActiveSheet.Name

Case "Example1"

Call Example1Code.Worksheet_Activate

Case "Example5"

Call Example5Code.Worksheet_Activate

End Select

CurrentWorksheetName = oEvent.Source.ActiveSheet.Name

End Sub

Sub ACTIVESHEET_disposing(oEvent)

msgbox "Disposing ACTIVESHEET"

End Sub

According to Mathias Bauer, a document's Controller object is changed if the view is changed. The solution is to register a FrameActionListener with the frame that contains the Controller. Every time a new component (in this case, the Controller) is attached to the frame, the frame sends a notification.

Language

Comments

It is always a good practice to liberally comment your code. What is clear today will not be clear tomorrow. The single quote character and REM both indicate that a comment is about to start. All text after this will be ignored.

REM This is a comment

REM And this is another comment

' And yet another comment

' I could do this all day long

Dim i As Integer REM i is used as in index variable in loops

Print i REM This will print the value of i

Variables

Names

Variable names are limited to 255 characters and they must start with a standard alphabet character and they may contain numbers. The underscore and space characters are also valid characters. No distinction is made between upper and lower case characters. Variable names with spaces must be enclosed in brackets “[]”.

Declaration

It is considered good practice to declare your variables before you use them. The “Option Explicit” statement forces you to do this. This line must exist in your code before any other. If you do not use “Option Explicit”, then it is possible that misspelled variable names will come back to haunt you as bugs.

To declare a variable you use Dim. The syntax for Dim is as follows:

[ReDim]Dim Name1 [(start To end)] [As Type][, Name2 [(start To end)] [As Type][,...]]

This allows you to declare a number of variables at one time. Name is any variable or array name. The start and end values may be in the range of -32768 to 32767. This defines the number of elements (inclusively) so both Name1(start) and Name1(end) are valid values. If ReDim is used, then the start and end values may be numeric expressions. Valid values for type include Boolean, Currency, Date, Double, Integer, Long, Object, Single, String, and Variant.

Variant is the default type if no type is specified unless the DefBool, DefDate, DefDbL, DefInt, DefLng, DefObj, or DefVar commands are used. These commands allow you to specify the data type based on the first letter of a variable name.

String objects are limited to 64K characters.

Variant objects may contain all types. The type is determined by what it assigned.

Object variables must be followed by a subsequent set.

The following example program demonstrates the problems that can arise if you do not declare your variables. The undeclared variable “truc” will default to type Variant. Execute this macro and see which types uses for the non-declared variable :

Sub TestNonDeclare

Print "1 : ", TypeName(truc), truc

truc= "ab217"

Print "2 : ", TypeName(truc), truc

truc= true

Print "3 : ", TypeName(truc), truc

truc= 5=5 ' should be a Boolean

Print "4 : ", TypeName(truc), truc

truc= 123.456

Print "5 : ", TypeName(truc), truc

truc=123

Print "6 : ", TypeName(truc), truc

truc= 1217568942 ' could be a Long

Print "7 : ", TypeName(truc), truc

truc= 123123123123123.1234 'should be a Currency

Print "8 : ", TypeName(truc), truc

End Sub

This is a strong argument to explicitly declare all variables.

Warning	Each variable type must be declared or it will default to type Variant. “Dim a, b As Integer” is equivalent to “Dim a As Variant, b As Integer”. Sub MultipleDeclaration Dim a, b As Integer Dim c As Long, d As String Dim e As Variant, f As Float Print TypeName(a) REM Empty, Variant by default Print TypeName(b) REM Integer, Declared Integer Print TypeName(c) REM Long, Declared Long Print TypeName(d) REM String, Declared String Print TypeName(e) REM Empty, Variant as declared Print TypeName(f) REM Object, Float is unknown type Print TypeName(g) REM Object, because NOT initialized End Sub

Evil Global Variables And Statics

Global variables are usually discouraged because they may be modified by any routine any time anywhere and it is difficult to know which methods modify which variables when they are used. Because of this I started placing the modifier “evil” before the term “global variable” while I was teaching at The Ohio State University. I used it as a tool to remind my students that although there is a time and place for global variables, you should think before you use them.

A global must be declared outside of a procedure. You can then use the Public and Private keywords to specify if this variable is global to all modules or just this one. If neither Public nor Private is explicitly stated, then Private is assumed. The syntax is the same as the Dim and ReDim statements.

Although variables are passed by reference unless it is requested otherwise, global variables appear to pass by value. This caused at least one bug in my code.

Every time a procedure is called, the variables local to the procedure are recreated. If you declare the variable Static, it will retain its value. In the example below, the Worker Sub counts the number of times it has been called. Remember that Numeric variables are initialized to zero and Strings are initialized to the empty string.

Option Explicit

Public Author As String REM Global to ALL Modules

Private PrivateOne$ REM Global to THIS Module only

Dim PrivateTwo$ REM Global to THIS Module only

Sub PublicPrivateTest

Author = "Andrew Pitonyak"

PrivateOne = "Hello"

Worker()

Worker()

End Sub

Sub Worker()

Static Counter As Long REM retains its value between calls

Counter = Counter + 1 REM count each time Worker is called

Print "Counter = " + Counter

Print "Author = " + Author

End Sub

Types

Abstractly speaking, OpenOffice.org Basic supports numeric, string, boolean, and object variable types. Objects are primarily used to refer to internals such as documents, tables, etc... With an object, you can use the objects corresponding methods and properties. Numeric types are initialized to zero and strings are initialized to the empty string “”.

If you need to know a variables type at runtime, TypeName function returns a string representation of the variable type. If you need to know a variables type at runtime, VarType function returns an integer corresponding to the variable type.

Keyword	Variable Type	VarType	Auto Type	Defxxx
Boolean	Boolean	11		DefBool
Currency	Currency with 4 Decimal places	6	@	
Date	Date	7		DefDate
Double	Double Floating Point	5	#	DefDbl
Integer	Integer	2	%	DefInt
Long	Long	3	&	DefLng
Object	Object	9		DefObj
Single	Single Floating Point	4	!	
String	String	8	$	
Variant	Can contain all types specified by the definition	12		DefVar
Empty	Variable is not initialized	0		
Null	No valid data	1		

Sub ExampleTypes

Dim b As Boolean

Dim c As Currency

Dim t As Date

Dim d As Double

Dim i As Integer

Dim l As Long

Dim o As Object

Dim f As Single

Dim s As String

Dim v As Variant

Dim n As Variant

Dim x As Variant

n = null

x = f

Print TypeName(b) + " " + VarType(b) REM Boolean 11

Print TypeName(c) + " " + VarType(c) REM Currency 6

Print TypeName(t) + " " + VarType(t) REM Date 7

Print TypeName(d) + " " + VarType(d) REM Double 5

Print TypeName(i) + " " + VarType(i) REM Integer 2

Print TypeName(l) + " " + VarType(l) REM Long 3

Print TypeName(o) + " " + VarType(o) REM Object 9

Print TypeName(f) + " " + VarType(f) REM Single 4

Print TypeName(s) + " " + VarType(s) REM String 8

Print TypeName(v) + " " + VarType(v) REM Empty 0

Print TypeName(n) + " " + VarType(n) REM Null 1

Print TypeName(x) + " " + VarType(x) REM Single 4

End Sub

Boolean Variables

Although boolean variables use the values “True” or “False,” they are internally represented by the integer values “-1” and “0” respectively. If you assign anything to a boolean and it does not precisely evaluate to “0”, then the “True” value is stored in the boolean. Typical uses are as follows:

Dim b as Boolean

b = True

b = False

b = (5 = 3)'Set to False

Print b 'Prints 0

b = (5 < 7)'Set to True

Print b 'Prints -1

b = 7 'Sets to True because 7 is not 0

Integer Variables

Integer variables are 16-bit numbers yielding a range of -32768 to 32767. Assigning a floating point number to an Integer is done by rounding to the nearest integer value. Postfixing a variable name with an “%” character causes it to become a Integer variable.

Sub AssignFloatToInteger

Dim i1 As Integer, i2%

Dim f2 As Double

f2= 3.5

i1= f2

Print i1 REM 4

f2= 3.49

i1= f2

Print i1 REM 3

End Sub

Long Integer Variables

Long integers variables are 32-bit numbers yielding a range of -2,147,483,648 to 2,147,483,647. Assigning a floating point number to a Long is done by rounding to the nearest integer value. Postfixing a variable name with an “&” character causes it to become a Long variable.

Dim Age&

Dim Dogs As Long

Currency Variables

Currency variables are 64-bit fixed four decimal and fifteen non-decimal numbers. This yields a range from -922,337,203,658,477.5808 to +922,337,203, 658,477.5807. Postfixing a variable name with an “@” character causes it to become a Currency variable.

Dim Income@

Dim Cost As Currency

Single Variables

Single variables are 32-bit numbers. The greatest magnitude is 3.402823 x 10E38. The smallest non-zero magnitude is 1.401298 x 10E-45. Postfixing a variable with the “!” character causes it to become a Single Variable.

Dim Weight!

Dim Height As Single

Double Variables

Double variables are 64-bit numbers. The greatest magnitude for a double variable is 1.79769313486232 x 10E308. The smallest non-zero magnitude for a double variable is 4.94065645841247 x 10E-324. Postfixing a variable with the “#” character causes it to become a Double Variable.

Dim Weight#

Dim Height As Double

String Variables

String variables use a 1-byte ASCII character for each character and are limited in length to 64Kbytes. Postfixing a variable with the “$” character causes it to become a String variable.

Dim FirstName$

Dim LastName As String

Object, Variant, Empty, and Null

The two special values Empty and Null are of interest when thinking of variables of type Object and Variant. The Empty value indicates that no value has been assigned to the variable. This is testable with the function IsEmpty(var). The Null value indicates that no valid value is present. This is testable with the function IsNull(var).

When a variable of type Object is first declared, it contains the value Null. When a variable of type Variant is first declared, it is Empty.

Sub ExampleObjVar

Dim obj As Object, var As Variant

Print IsNull(obj) REM True

Print IsEmpty(obj) REM False

obj = CreateUnoService("com.sun.star.beans.Introspection")

Print IsNull(obj) REM False

obj = Null '?? Check this on 1.0.3.1

Print IsNull(obj) REM True

Print IsNull(var) REM False

Print IsEmpty(var) REM True

var = obj

Print IsNull(var) REM True

Print IsEmpty(var) REM False

var = 1

Print IsNull(var) REM False

Print IsEmpty(var) REM False

var = Empty REM IsEmpty(Empty) fails in 1.0.3.1 but works in 1.1 beta

Print IsEmpty(var) REM True

End Sub

Should I Use Object Or Variant

When writing code that interacts with the UNO objects, you must decide which type to use. Most of the examples usually use type Object. On page 132, however, the Developer's Guide suggests otherwise .

Always use the type Variant to declare variables for UNO objects, not the type Object. The OpenOffice.org Basic type Object is tailored for pure OpenOffice.org Basic objects and not for UNO OpenOffice.org Basic objects. The Variant variables are best for UNO objects to avoid problems that can result from the OpenOffice.org Basic specific behavior of the type Object:

Dim oService1 ' Ok

oService1 = CreateUnoService( "com.sun.star.anywhere.Something" )

Dim oService2 as Object ' NOT recommended

oService2 = CreateUnoService( "com.sun.star.anywhere.SomethingElse" )

Andreas Bregas adds that for most cases both works. The Developer's Guide prefers variant because there are some odd situations where the usage of type object leads to an error due to the old object type semantics. But if a program uses type object and runs correctly with this there should be no problem.

Constants

OpenOffice.org Basic already knows the values “True”, “False”, and “PI”. You can also define your own constants. Each constant may be defined once, and only once. Constants are not type defined, they are simply inserted as typed.

Const Gravity = 9.81

Arrays

An array allows you to store many different values in a single variable. By default, the first item in an array is at location 0. You may, however, specify the starting and ending values. Here are some examples

Dim a(5) As Integer REM 6 elements from 0 to 5 inclusive

Dim b$(5 to 10) As String REM 6 elements from 5 to 10 inclusive

Dim c(-5 to 5) As String REM 11 elements from -5 to 5 inclusive

Dim d(5 To 10, 20 To 25) As Long

If you have a variant array and you want to fill it quickly, use the Array function. This returns a Variant array with the included data. This is how I build a list of data.

Sub ExampleArray

Dim a(), i%

a = Array(0, 1, 2)

a = Array("Zero", 1, 2.0, Now)

REM String, Integer, Double, Date

For i = LBound(a()) To UBound(a())

Print TypeName(a(i))

Next

End Sub

Option Base

You may change the default lower bound of an array to start at 1 rather than zero. This must be done before any other executable statement in the program.

Syntax: Option Base { 0 | 1 }

LBound(arrayname[,Dimension])

Returns the lower bound of an array. The optional second parameter which is the dimension of the array for which you desire a lower bound is 1 based (not zero based).

LBound(a()) REM 0

LBound(b$()) REM 5

LBound(c()) REM -5

LBound(d()) REM 5

LBound(d(), 1) REM 5

LBound(d(), 2) REM 20

UBound(arrayname[,Dimension])

Returns the upper bound of an array. The optional second parameter which is the dimension of the array for which you desire an upper bound is 1 based (not zero based).

UBound(a()) REM 5

UBound(b$()) REM 10

UBound(c()) REM 5

UBound(d()) REM 10

UBound(d(), 1) REM 10

UBound(d(), 2) REM 25

Is This Array Defined

If an array is really an empty list, then the lower bound of the array will be larger than the upper bound of the array.

DimArray, Changing The Dimension

The DimArray function is used to set or change the number of dimensions of a Variant array. DimArray( 2, 2, 4 ) is the same as DIM a( 2, 2, 4 ).

Sub ExampleDimArray

Dim a(), i%

a = Array(0, 1, 2)

Print "" & LBound(a()) & " " & UBound(a()) REM 0 2

a = DimArray()

' Empty array

i = 4

a = DimArray(3, i)

Print "" & LBound(a(),1) & " " & UBound(a(),1) REM 0, 3

Print "" & LBound(a(),2) & " " & UBound(a(),2) REM 0, 4

End Sub

ReDim, Changing The Number Of Elements

The ReDim statement is used to change the size of an array.

Dim e() As Integer REM I did not specify the size

ReDim e(5) As Integer REM 0 to 5 is valid

ReDim e(10) As Integer REM 0 to 10 is valid

The Preserve keyword may be used with the ReDim statement to preserve the contents of the array when it is re-dimensioned.

Sub ReDimExample

Dim a(5) As Integer

Dim b()

Dim c() As Integer

a(0) = 0

a(1) = 1

a(2) = 2

a(3) = 3

a(4) = 4

a(5) = 5

REM a is dimensioned from 0 to 5 where a(i) = i

PrintArray("a at start", a())

REM a is dimensioned from 1 to 3 where a(i) = i

ReDim Preserve a(1 To 3) As Integer

PrintArray("a after ReDim", a())

REM Array() returns a variant type

REM b is dimensioned from 0 to 9 where b(i) = i+1

b = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)

PrintArray("b at initial assignment", b())

REM b is dimensioned from 1 to 3 where b(i) = i+1

ReDim Preserve b(1 To 3)

PrintArray("b after ReDim", b())

REM The following is NOT valid because the array is already dimensioned

REM to a different size

REM a = Array(0, 1, 2, 3, 4, 5)

REM c is dimensioned from 0 to 5 where a(i) = i

REM If a "ReDim" had been done on c, then this would NOT work

c = Array(0, 1, 2, 3, 4, 5)

PrintArray("c, of type Integer after assignment", c())

REM Ironically, this allowed but c will contain no data!

ReDim Preserve c(1 To 3) As Integer

PrintArray("c after ReDim", c())

End Sub

Sub PrintArray (lead$, a() As Variant)

Dim i%, s$

s$ = lead$ + Chr(13) + LBound(a()) + " to " + UBound(a()) + ":" + Chr(13)

For i% = LBound(a()) To UBound(a())

s$ = s$ + a(i%) + " "

Next

MsgBox s$

End Sub

The Array function mentioned above only works to create a Variant array. To initialize an array of a known type, you can use the following method.

Sub ExampleSetIntArray

Dim iA() As Integer

SetIntArray(iA, Array(9, 8, 7, 6))

PrintArray("", iA)

End Sub

Sub SetIntArray(iArray() As Integer, v() As Variant)

Dim i As Long

ReDim iArray(LBound(v()) To UBound(v())) As Integer

For i = LBound(v) To UBound(v)

iArray(i) = v(i)

Next

End Sub

Testing Objects

To determine the type of a variable, you can use the boolean functions IsArray, IsDate, IsEmpty, IsMissing, IsNull, IsNumeric, IsObject, and IsUnoStruct. The IsArray function returns true if the parameter is an array. The IsDate function returns true if it is possible to convert the object into a Date. A string with a properly formatted date will therefore return true for the IsDate function. The IsEmpty method is used to test if a Variant type object has been initialized. The IsMissing function indicates if an Optional parameter is missing. The IsNull method tests whether a Variant contains the special Null value, indicating that the variable contains no data. IsNumeric is used to test if a string contains numeric values. The IsUnoStruct function takes the string name of an UNO structure and returns true only if it is a valid name.

Comparison Operators

Conditionals generally work as expected but they do not perform short circuit evaluation. The following standard conditional operators are used

Symbol	Meaning
=	Equal To
<	Less Than
>	Greater Than
<=	Less Than or Equal To
>=	Greater Than or Equal To
<>	Not Equal To
Is	Are these the same Object

The AND operator performs a logical operation on Boolean types and bitwise operations on numeric types. The OR operator performs a logical operation on Boolean types and bitwise operations on numeric types. The XOR operator performs a logical operation on Boolean types and bitwise operations on numeric types. Remember that this is “Exclusive OR”. The NOT operator performs a logical operation on Boolean types and bitwise operations on numeric types. A simple test shows that the standard precedence roles exist, namely that AND has greater precedence than the OR operators.

?? On 7/28/03, Andrew has decided that this is incorrect! Oops on me!

Option Explicit

Sub ConditionTest

Dim msg As String

msg = "AND has "

msg = msg & IIf(False OR True AND False, "equal", "greater")

msg = msg & " precedence than OR" & Chr(13) & "OR does "

msg = msg + IIF(True XOR True OR True, "", "not ")

msg = msg + "have greater precedence than XOR" + Chr(13)

msg = msg & "XOR does "

msg = msg + IIF(True OR True XOR True, "", "not ")

msg = msg + "have greater precedence than OR"

MsgBox msg

End Sub

Functions and SubProcedures

A Function is a Sub procedure that can return a value. This allows it to be used in an expression. Subs and Functions start as follows:

Start Syntax: Function FuncName[(Var1 [As Type][, Var2 [As Type][,...]]]) [As Type]
Start Syntax: Sub SubName[(Var1 [As Type][, Var2 [As Type][,...]]])

Functions declare a return value type because they return a value. To assign the return value, use a statement of the form “FuncName = return_value”. Although you may perform this assignment multiple times, it is the last one that is returned.

To immediately leave the procedure use an appropriate Exit statement.

Optional Parameters

A parameter may be declared as optional using the Optional keyword. The IsMissing method is then used to determine if a parameter was passed.

Sub testOptionalParameters()

Print TestOpt() REM MMM

Print TestOpt(,) REM MMM

Print TestOpt(,,) REM MMM

Print TestOpt(1) REM 1MM

Print TestOpt(1,) REM 1MM

Print TestOpt(1,,) REM 1MM

Print TestOpt(1,2) REM 12M

Print TestOpt(1,2,) REM 12M

Print TestOpt(1,2,3) REM 123

Print TestOpt(1,,3) REM 1M3

Print TestOpt(,2,3) REM M23

Print TestOpt(,,3) REM MM3

Print TestOptI() REM MMM

Print TestOptI(,) REM 488MM (Error)

Print TestOptI(,,) REM 488488M (Error)

Print TestOptI(1) REM 1MM

Print TestOptI(1,) REM 1MM

Print TestOptI(1,,) REM 1488M (Error)

Print TestOptI(1,2) REM 12M

Print TestOptI(1,2,) REM 12M

Print TestOptI(1,2,3)REM 123

Print TestOptI(1,,3) REM 14883 (Error)

Print TestOptI(,2,3) REM 48823 (Error)

Print TestOptI(,,3) REM 4884883 (Error)

End Sub

Function TestOpt(Optional v1 As Variant, Optional v2 As Variant, Optional v3 As Variant) As String

Dim s As String

s = "" & IIF(IsMissing(v1), "M", Str(v1))

s = s & IIF(IsMissing(v2), "M", Str(v2))

s = s & IIF(IsMissing(v3), "M", Str(v3))

TestOpt = s

End Function

Function TestOptI(Optional i1 As Integer, Optional i2 As Integer, Optional i3 As Integer) As String

Dim s As String

s = "" & IIF(IsMissing(i1), "M", Str(i1))

s = s & IIF(IsMissing(i2), "M", Str(i2))

s = s & IIF(IsMissing(i3), "M", Str(i3))

TestOptI = s

End Function

Warning	As of version 1.0.3.1, IsMissing will fail with Optional parameters if the type is not Variant and the missing optional parameter is represented by two consecutive commas. I first investigated this behavior after speaking with Christian Anderson [ca@ofs.no]. This is issue 11678 in issuezilla.

Parameters By Reference Or Value

If a variable is passed by value, I can change the parameter in the called procedure and the original variable will not change. If I pass a reference instead, then if I change the parameter I also change the original variable. The default behavior is to pass by reference. To pass by value, use the ByVal keyword before the parameter declaration. If the parameter is a constant such as “4” and you modify it in the called procedure it may, or may not, really change. According to Andreas Bregas (ab@openoffice.org) this is a bug so I have opened an issue in issuezilla (http://www.openoffice.org/project/www/issues/show_bug.cgi?id=12272).

Option Explicit

Sub LoopForever

Dim l As Long

l = 4

LoopWorker(l)

Print "Passed l by value and it is still " + l

LoopForeverWorker(l)

' l is now 1 so this will print 1.

Print "Passed l by reference and it now is " + l

' This will loop forever because 4 is a constant

' and you can NOT change it.

Print "Passing a constant parameter by reference, this will be fun"

Print LoopForeverWorker(4)

End Sub

Sub LoopWorker(ByVal n As Long)

Do While n > 1

Print n

n = n - 1

Loop

End Sub

Sub LoopForeverWorker(n As Long)

Do While n > 1

' This is fun when n is a constant.

Print n

n = n - 1

Loop

End Sub

Recursion

Your functions can be recursive as of 1.1.1. Different versions of OOo on different operating systems support different recursion levels, so be careful.

Option Explicit

Sub DoFact

Print "Recursive = " + RecursiveFactorial(4)

Print "Normal Factorial = " + Factorial(4)

End Sub

Function Factorial(n As Long) As Long

Dim answer As Long

Dim i As Long

i = n

answer = 1

Do While i > 1

answer = answer * i

i = i - 1

Loop

Factorial = answer

End Function

' This will fail because you can not use recursion

Function RecursiveFactorial(n As Long) As Long

If n > 1 Then

RecursiveFactorial = n * RecursiveFactorial(n-1)

Else

RecursiveFactorial = 1

End If

End Function

Flow Control

If Then Else

The If construct is used to execute a block of code based on an expression. Although you can use GoTo or GoSub to jump out of an If block, you can not jump into an If block.

Syntax:

If condition=true Then

Statementblock

[ElseIf condition=true Then]

Statementblock

[Else]

Statementblock

End If

Syntax:

If condition=true Then Statement

Example:

If x < 0 Then

MsgBox "The number is negative"

ElseIf x > 0 Then

MsgBox "The number is positive"

Else

MsgBox "The number is zero"

End If

IIF

The IIF construct is used to return an expression based on a condition. This is similar to the “?” syntax in C.

Syntax: IIf (Condition, TrueExpression, FalseExpression)

This is very similar to the following code:

If (Condition) Then

object = TrueExpression

Else

object = FalseExpression

End If

max_age = IIf(johns_age > bills_age, johns_age, bills_age)

Choose

The choose statement allows selecting from a list of values based on an index.

Syntax: Choose (Index, Selection1[, Selection2, ... [,Selection_n]])

If the index is 1, then the first item is returned. If the index is 2, then the second item is returned. You can figure out the rest!

For....Next

The on-line help contains an excellent complete description, read it.

Repeat a block of statements a specified number of times.

Syntax:

For counter=start To end [Step step]

statement block

[Exit For]

statement block

Next [counter]

The numeric “counter” is initially assigned the “start” value. If the “step” value is not given, then the counter is incremented by one until it passes the “end” value. If the “step” value is given, then the “step” is added to the “start” value until it passes the “end” value. The statement blocks are executed once for each increment.

The “counter” is optional on the “Next” statement, and it automatically refers to the most recent “For” statement.

You may prematurely leave a for statement by using the “Exit For” statement. This will exit the most recent “For” statement.

Example:

The following example fills an array with random integers. The array is then sorted using two nested loops .

Sub ForNextExampleSort

Dim iEntry(10) As Integer

Dim iCount As Integer, iCount2 As Integer, iTemp As Integer

Dim bSomethingChanged As Boolean

' Fill the array with the integers between -10 and 10

For iCount = LBound(iEntry()) To Ubound(iEntry())

iEntry(iCount) = Int((20 * Rnd) -10)

Next iCount

' Sort the array

For iCount = LBound(iEntry()) To Ubound(iEntry())

'Assume that the array is sorted

bSomethingChanged = False

For iCount2 = iCount + 1 To Ubound(iEntry())

If iEntry(iCount) > iEntry(iCount2) Then

iTemp = iEntry(iCount)

iEntry(iCount) = iEntry(iCount2)

iEntry(iCount2) = iTemp

bSomethingChanged = True

End If

Next iCount2

'If the array is already sorted then stop looping!

If Not bSomethingChanged Then Exit For

Next iCount

For iCount = 1 To 10

Print iEntry(iCount)

Next iCount

End Sub

Do Loop

The on-line help contains an excellent complete description, read it.

The Loop construct has a few different forms and is used to continue executing a block of code while a condition is true. The most common form checks the condition before the loop starts and as long as the condition is true will repeatedly execute the block of code. If the condition is false, then the loop will never be executed.

Do While condition

Block

Loop

A similar but much less common form checks the condition before the loop starts and as long as the condition is false will repeatedly execute the block of code. If the condition evaluates to true immediately, then the loop is never run.

Do Until condition

Block

Loop

You may also place the check at the end of the loop in which case the block of code will always be executed at least once. To always execute the loop at least once and then continue as long as the condition is true, use the following construct:

Do

Block

Loop While condition

To always execute the loop at least once and then continue as long as the condition is false, use the following construct:

Do

Block

Loop Until condition

In a “Do Loop”, you can force an immediate exit from the loop with the “Exit Do” statement.

Select Case

The Select Case statement is similar to the “case” and “switch” statements in other languages. This mimics multiple “Else If” blocks in an “If” statement. A single condition expression is specified and this is compared against multiple values for a match as follows:

Select Case condition_expression

Case case_expression1

StatementBlock1

Case case_expression2

StatementBlock2

Case Else

StatementBlock3

End Select

The condition_expression is the expression that will be compared in each Case statement. I am not aware of any particular data type limitations other than the condition type must be compatible with the expression type. The first statement block to match is executed. If no condition matches, then the optional Case Else will match.

Case Expressions

A case expression is usually a constant such as “Case 4” or “Case "hello"”. Multiple values may be specified by separating them with commas: “Case 3, 5, 7”. If you want to check a range of values, there is a “To” keyword “Case 5 To 10”. Open ended ranges may be checked as “Case < 10” or with the “Is” keyword “Case Is < 10”.

Warning	Be careful when using a range in a Case statement. The on-line help has repeatedly contained incorrect examples such as “Case i > 2 AND i < 10”. This is difficult to understand and code correctly.

Incorrect Simple Example

I have seen many incorrect examples so I will spend some time to show a few examples of things that will not work. I will start with a very simple example. Consider the following:

Correct	Correct	Incorrect
i = 2 Select Case i Case 2	i = 2 Select Case i Case Is = 2	i = 2 Select Case i Case i = 2

The bad example fails because “Case i = 2” reduces to “Case Is = (i = 2)”. The expression (i=2) evaluates to True, which is -1 so this is evaluated as “Case Is = -1” in this example.

If you understand this simple incorrect example, then you are ready for difficult examples.

Incorrect Range Example

The following incorrect example was in the on-line help.

Case Is > 8 AND iVar < 11

This does not work because it is evaluated as :

Case Is > (8 AND (iVar < 11))

The expression (iVar<11) is evaluated as true or false. Remember that true= -1 and false=0. The AND is then bitwise applied between 8 and -1 (true) or 0 (false), which results in either 8 or 0. This expression reduces to one of two expressions.

If iVar is less than 11 :

Case Is > 8

If iVar is greater or equal to 11 :

Case Is > 0

Incorrect Range Example

I have also seen this incorrect example in print.

Case i > 2 AND i < 10

This does not work because it is evaluated as

Case Is = (i > 2 AND i < 10)

Ranges, The Correct Way

The statement

Case Expression

is probably correct if it can be written

Case Is = (Expression)

My initial solution follows:

Case Iif(Boolean Expression, i, i+1)

I was proud of myself until I was given the following brilliant solution by Bernard Marcelly:

Case i XOR NOT (Boolean Expression)

After my initial confusion, I realized how brilliant this really is. Do not be tempted to simplify this to the obvious reduction of “i AND ()” because it will fail if i is 0. I made that mistake.

Sub DemoSelectCase

Dim i%

i = Int((15 * Rnd) -2)

Select Case i%

Case 1 To 5

Print "Number from 1 to 5"

Case 6, 7, 8

Print "Number from 6 to 8"

Case IIf(i > 8 AND i < 11, i, i+1)

Print "Greater than 8"

Case i% XOR NOT(i% > 8 AND i% < 11 )

Print i%, "Number is 9 or 10"

Case Else

Print "Out of range 1 to 10"

End Select

End Sub

While...Wend

There is nothing special about the While...Wend construct, it has the following form:

While Condition

Code

Wend

Tip	This construct has limitations that do not exist in the Do While...Loop construct and offers no particular benefits. You can not use the Exit construct, nor can you exit with a GoTo.

GoSub

The GoSub statement causes execution to jump to a defined subroutine label in the current subroutine. You can not jump outside the current subroutine. When the Return statement is reached, execution will continue from the point of the original call. If a Return statement is encountered and no previous GoSub was made, an error occurs. In other words, Return is not a substitute for Exit Sub or Exit Function. It is generally assumed that the use of functions and subroutines produce more understandable code than the use of GoSub and GoTo.

Option Explicit

Sub ExampleGoSub

Dim i As Integer

GoSub Line2

GoSub Line1

MsgBox "i = " + i, 0, "GoSub Example"

Exit Sub

Line1:

i = i + 1

Return

Line2:

i = 1

Return

End Sub

Tip	GoSub is a persistent remnant from old dialects, retained for compatibility. GoSub is strongly discouraged because it tends to produce unreadable code. Subs or Functions are preferable.

GoTo

The GoTo statement causes execution to jump to a defined label in the current subroutine. You can not jump outside the current subroutine.

Sub ExampleGoTo

Dim i As Integer

GoTo Line2

Line1:

i = i + 1

GoTo TheEnd

Line2:

i = 1

GoTo Line1

TheEnd:

MsgBox "i = " + i, 0, "GoTo Example"

End Sub

Tip	GoTo is a persistent remnant from old dialects, retained for compatibility. GoTo is strongly discouraged because it tends to produce unreadable code. Subs or Functions are preferable.

On GoTo

Syntax: On N GoSub Label1[, Label2[, Label3[,...]]]
Syntax: On N GoTo Label1[, Label2[, Label3[,...]]]

This causes the execution to branch a label based on the the numeric expression N. If (N=0) then no branching occurs. The numeric expression N must be in the range of 0 and 255. This is similar to the “computed goto,” “case,” and “switch,” statements in other languages. Do not try to jump out of the current subroutine or function.

Option Explicit

Sub ExampleOnGoTo

Dim i As Integer

Dim s As String

i = 1

On i+1 GoSub Sub1, Sub2

s = s & Chr(13)

On i GoTo Line1, Line2

REM The exit causes us to exit if we do not continue execution

Exit Sub

Sub1:

s = s & "In Sub 1" : Return

Sub2:

s = s & "In Sub 2" : Return

Line1:

s = s & "At Label 1" : GoTo TheEnd

Line2:

s = s & "At Label 2"

TheEnd:

MsgBox s, 0, "On GoTo Example"

End Sub

Exit

The Exit statement is used to exit a Do Loop, For Next, Function, or a Sub. Attempting to exit a non-enclosing construct will cause an error. For example, you can not exit a For loop if you are not in one. The forms are as follows:

Exit DO Continue execution following Loop statement.

Exit For Continue execution following the Next statement.

Exit Function Immediately exit the current function.

Exit Sub Immediately exit the current Sub.

Option Explicit

Sub ExitExample

Dim a%(100)

Dim i%

REM Fill the array with 100, 99, 98, ..., 0

For i = LBound(a()) To UBound(a())

a(i) = 100 - i

Next i

Print SearchIntegerArray(a(), 0 )

Print SearchIntegerArray(a(), 10 )

Print SearchIntegerArray(a(), 100)

Print SearchIntegerArray(a(), 200)

End Sub

Function SearchIntegerArray( list(), num%) As Integer

Dim i As Integer

SearchIntegerArray = -1

For i = LBound(list) To UBound(list)

If list(i) = num Then

SearchIntegerArray = i

Exit For

End If

Next i

End Function

Error Handling

Your macro may encounter several types of errors. Some errors you should check for, such as missing files, and some you should simply trap. To trap errors in macros, use the “On Error” statement.

On [Local] {Error GoTo Labelname | GoTo 0 | Resume Next}

On Error allows you to specify how errors should be handled including the ability to setup your own error handler. If “Local” is used, then this defines an error handling routine local to the containing subroutine or function. If “Local” is not used then the error handling affects the entire module.

Tip	A procedure may contain several On Error statements. Each On Error may treat errors differently. (The on-line help incorrectly states that error handling must occur at start of the procedure).

Specify How To Handle The Error

To ignore all errors, use “On Error Resume Next”. When an error occurs, the statement that caused the error will skipped and the next statement will be executed.

To specify your own error handler, use “On Error GoTo Label”. To define a Label in OOo Basic, type some text on a line by itself and follow it with a colon. Line labels must be unique. When an error occurs, execution will be transferred to the label.

After specifying a method of handling errors, you can undo this using “On Error GoTo 0”. The next time an error occurs, your handler will not be invoked. This is not the same as “On Error Resume Next”, it means that the next error will be handled in the default manner (stopping macro execution with an error message).

Write The Error Handler

When an error occurs and execution is transferred to your error handler, there are some functions that help you determine what happened and where.

Error([num]) : Returns the error message as a string. You may optionally provide an error number to retrieve the error message for a specific error number. The message text is in the localized language.

Err() : Returns the error number of the last error.

Erl() : Returns the line number where the last error occurred.

After the error has been handled, you must decide how to proceed.

Do nothing and allow execution to proceed.

Exit the subroutine or function using “Exit Sub” or “Exit Function”.

Use “Resume” to execute the same line again. Be careful with this, if you have not corrected the error, it is possible that you will be stuck in an infinite loop.

Sub ExampleResume

Dim x%, y%

x = 4 : y = 0

On Local Error Goto oopsy

x = x / y

Print x

Exit Sub

oopsy:

y = 2

Resume

End Sub

Use “Resume Next” to resume macro execution on the line immediately following error.

Sub ExampleResumeNext

Dim x%, y%

x = 4 : y = 0

On Local Error Goto oopsy

x = x / y

Print x

Exit Sub

oopsy:

x = 7

Resume Next

End Sub

Use “Resume Label:” to continue execution at a specified label.

Sub ExampleResumeLabel

Dim x%, y%

x = 4 : y = 0

On Local Error Goto oopsy

x = x / y

GoHere:

Print x

Exit Sub

oopsy:

x = 7

Resume GoHere:

End Sub

An Example

The following example demonstrates many excellent error handling examples.

'******************************************************************

'Author: Bernard Marcelly

'email: marcelly@club-internet.fr

Sub ErrorHandlingExample

Dim v1 As Double

Dim v2 As Double

Dim v0 As Double

On Error GoTo TreatError1

v0 = 0 : v1= 45 : v2= -123 ' initialize to some value

v2= v1 / v0 ' divide by zero => error

Print "Result1:", v2

On Error Goto TreatError2 ' change error handler

v2= 456 ' initialize to some value

v2= v1 / v0 ' divide by zero = error !

Print "Result2:", v2 ' will not be executed

Label2:

Print "Result3:", v2 ' jumped to by error handling

On Error Resume Next ' ignore any error

v2= 963 ' initialize to some value

v2= v1 / v0 ' divide by zero = error !

Print "Result4:", v2 ' will be executed

On Error Goto 0 ' disable current error handler

REM standard error handling is now active

v2= 147 ' initialize to some value

v2= v1 / v0 ' divide by zero = error !

Print "Result5:", v2 ' will not be executed

Exit Sub

TreatError1:

Print "TreatError1 : ", error

v2= 0

Resume Next ' continue after statement on error

TreatError2:

Print "TreatError2 : line ", erl, "error number", err

v2= 123456789

Resume Label2

End Sub

Miscellaneous

This section contains bits and pieces of things that I only know because I have seen examples but have not found examples for. ???

*********

Many statements may exist on the same line if they are separated by a “:” (colon).

*********

For single line statements, the “If Then” construct does not require the closing “End If”.

Sub SimpleIf

If 4 = 4 Then Print "4 = 4" : Print " Hello you" REM This prints

If 3 = 2 Then Print "3 = 2" REM This does not

End Sub

*********

Libraries, dialogs, IDE, Import and Export of Macros.

With object ... End With

*********

How about a command line start?

The Parameter for the call macros reads:

soffice.exe macro:/library module macro

Example:

soffice.exe macro:///standard.module1.macro1

But note! If the macro makes or opens nothing within a document, the macro is implemented and closed StarOffice again.

Note: mention the document transformer by Laurent Godard!

*********

Copying an object will simply copy the reference. Copying a structure makes a new copy. See EqualUnoObjects for an example.?? This can cause a problem and then the object will have to be copied back!

*********

******

*******

Operators and Precedence

OpenOffice.org Basic supports the basic numerical operators -, +, /, *, and ^. The operators use the standard precedence orders, but I have indicated them here anyway. The Logical operators return 0 for false (no bits set) and -1 for true (all bits set). For a more complete description, see the section listing operators and functions.

Precedence	Operator	Description
0	AND	Bitwise on numerics and logical on Boolean
0	OR	Bitwise on numerics and logical on Boolean
0	XOR	Bitwise on numerics and logical on Boolean
0	EQV	Logical and/or Bitwise equivalence
0	IMP	Logical Implication (buggy as of 1.0.3.1)
1	=	Logical
1	<	Logical
1	>	Logical
1	<=	Logical
1	>=	Logical
1	<>	Logical
2	-	Numerical Subtraction
2	+	Numerical Addition and String Concatenation
2	&	String Concatenation
3	*	Numerical Multiplication
3	/	Numerical Division
3	MOD	Numerical remainder after division
4	^	Numerical Exponentiation

Sub TestPrecedence

Dim i%

Print 1 + 2 OR 1 REM Prints 3

Print 1 + (2 OR 1) REM Prints 4

Print 1 + 2 AND 1 REM Prints 1

Print 1 + 2 * 3 REM Prints 7

Print 1 + 2 * 3 ^2 REM Prints 19

Print 1 = 2 OR 4 REM Prints 4

Print 4 AND 1 = 1 REM Prints 4

End Sub

Warning	Boolean values are internally stored as integers with False = 0 and True = -1. This allows numerical operators to be used with Boolean values but I discourage this (1 + True = False). Use boolean operators instead.

String Manipulations

offers a few methods for the manipulation of strings.

Function	Description
Asc(s$)	ASCII value of the first character in the string.
Chr$(i)	Return the character corresponding to the ASCII code.
CStr(Expression)	Convert the numeric expression to a string.
Format(number [, f])	Format the number based on the format string.
Hex(Number)	String that represents the hexadecimal value of a number.
InStr([i,] s$, f$[, c])	Position of f in s, 0 if not found. Can be case-insensitive. Return type is Long value coerced into an Integer so negative values may be returned for large strings.
LCase(s$)	Returns string as all lower case.
Left(s$, n)	Return the leftmost n characters from s. n is an integer but the string may be 64K in size.
Len(s$)	Returns the length of the string s.
LSet s$ = Text	Left align a string. Broken in 1.0.3.1, fixed in 1.1
LTrim(s$)	Return a string with no leading spaces. Does not modify the string.
Mid(s$, i[, n])	Substring from location i of length n.
Mid(s$, i, n, r$)	Replace the substring with r with limitations. I use to delete portions.
Oct(Number)	String that represents the Octal value of a number.
Right(s$, n)	Return the rightmost n characters from s. n is an integer but the string may be 64K in size.
RSet s$ = Text	Right align a string.
RTrim(s$)	Return string with no trailing spaces.
Space(n)	Returns a string that consists of a specified amount of spaces.
Str(Expression)	Convert the numeric expression to a string.
StrComp(x$, y$[, c])	Return -1 if x>y, 0 if x=y, and 1 if x<y. If c=1 then case-insensitive.
String(n, {i | s$})	Create a string with n characters. If an integer is used, this is considered the ASCII character to repeat. If a string is used, then the first character is repeated n times.
Trim(s$)	Return a string with no leading or trailing space from the string.
UCase(s$)	Returns string as all upper case.
Val(s$)	Convert the string to a number.

In the on-line help, the example for case conversion is incorrect. Here is how it should read.

Sub ExampleLUCase

Dim sVar As String

sVar = "Las Vegas"

Print LCase(sVar) REM Returns "las vegas"

Print UCase(sVar) REM Returns "LAS VEGAS"

end Sub

Remove Characters From String

This will remove characters from a string. The silly thing about this macro is that it is better written using the built in mid() method. The difference is that the mid() method modifies the current string whereas this returns a new string. I still should have done this using the mid() method, but I did not know about it until later.

'Remove a certain number of characters from a string

Function RemoveFromString(s$, index&, num&) As String

If num = 0 Or Len(s) < index Then

'If removing nothing or outside the range then return the string

RemoveFromString = s

ElseIf index <= 1 Then

'Removing from the start

If num >= Len(s) Then

RemoveFromString = ""

Else

RemoveFromString = Right(s, Len(s) - num)

End If

Else

'Removing from the middle

If index + num > Len(s) Then

RemoveFromString = Left(s,index - 1)

Else

RemoveFromString = Left(s,index - 1) + Right(s, Len(s) - index - num + 1)

End If

End If

End Function

Replace Text In String

This may be used to delete areas of a string by specifying the replacement string as an empty string. My initial thought was that I could use the mid() method for this as well, but it turns out that the mid method can not cause the string to become larger than it currently is. Because of this, I had to write this macro. It does not modify the existing string, but creates a new string with the replacement in place.

REM s$ is the input string to be modified

REM index is a long indicating where the replacement should be made in the string. (1 based)

REM If index is <= 1 then the text is inserted in front of the string.

REM If index > Len(s) then it is inserted at the end.

REM num is a long indicating how many characters to replace.

REM If num is zero length then nothing is removed, but the new string is inserted.

REM replaces is the string to place into the string.

Function ReplaceInString(s$, index&, num&, replaces$) As String

If index <= 1 Then

'Place this in front of the string

If num < 1 Then

ReplaceInString = replaces + s

ElseIf num > Len(s) Then

ReplaceInString = replaces

Else

ReplaceInString = replaces + Right(s, Len(s) - num)

End If

ElseIf index + num > Len(s) Then

ReplaceInString = Left(s,index - 1) + replaces

Else

ReplaceInString = Left(s,index - 1) + replaces + Right(s, Len(s) - index - num + 1)

End If

End Function

Printing The ASCII Values Of A String

This may seem like an odd macro to have, but I used this macro to decide how text was stored in a document. This will print the entire string as a set of ASCII numbers.

Sub PrintAll

PrintAscii(ThisComponent.text.getString())

End Sub

Sub PrintAscii(TheText As String)

If Len(TheText) < 1 Then Exit Sub

Dim msg$, i%

msg = ""

For i = 1 To Len(TheText)

msg = msg + Asc(Mid(TheText,i,1)) + " "

Next i

Print msg

End Sub

Remove All Occurrences Of A String

REM This deletes all occurrences of bad$ from s$

REM This modifies the string s$

Sub RemoveFromString(s$, bad$)

Dim i%

i = InStr(s, bad)

Do While i > 0

Mid(s, i, Len(bad), "")

i = InStr(i, s, bad)

Loop

End Sub

Numeric Manipulations

Function	Description
Abs(Number)	Return the absolute value of the number as a Double.
Asc(s$)	Return the ASCII Integer of the first character in the string.
Atn(x)	Return the angle, in radians, whose tangent is x
Blue(color)	Returns the Blue component of the given color code.
CByte(Expression)	Convert a string or number to a byte.
CDbl(Expression)	Convert a string or number to a Double.
CInt(Expression)	Convert a string or number to an Integer.
CLng(Expression)	Convert a string or number to a Long.
Cos(x)	Calculates the cosine of an angle specified in radians.
CSng(Expression)	Convert a string or number to a single precision number.
CStr(Expression)	Convert a string or number to a String.
Exp(Expression)	Base of the natural logarithm (e = 2.718282) raised to a power.
Fix(Expression)	Return the integer portion of a number after truncation.
Format(number [, f$])	Format the number based on the format string.
Green(color)	Returns the Green component of the given color code.
Hex(Number)	String that represents the hexadecimal value of a number.
Int(Number)	Rounds the integer toward negative infinity. See Also: Fix().
IsNumeric (Var)	Tests whether the given expression is a number.
Log(Number)	Natural logarithm of a number.
Oct(Number)	String that represents the Octal value of a number.
Randomize [Number]	Initializes the random-number generator.
Red(color)	Returns the Red component of the given color code.
RGB (Red, Green, Blue)	Long color value consisting of red, green, and blue components.
Rnd [(Expression)]	Return a random number between 0 and 1.
Sgn (Number)	Returns 1, -1, or 0 if the number is positive, negative, or zero.
Sin(x)	Calculates the sine of an angle specified in radians.
Sqr(Number)	Square root of a numeric expression.
Tan(x)	Calculates the tangent of an angle specified in radians.
n = TwipsPerPixelX	Returns the number of twips representing the width of a pixel.
n = TwipsPerPixelY	Returns the number of twips representing the height of a pixel.
Val(s$)	Convert a string to a number.

Date Manipulations

Function	Description
CDate(Expression)	Convert a string or number to a date.
CDateFromIso(String)	Return the internal date number from a string containing a date in ISO format.
CDateToIso(Number)	Returns the date in ISO format from a serial date number that was generated with DateSerial or DateValue.
Date	Return the current system date.
Date = s$	Set the current system date.
DateSerial(y%, m%, d%)	Return a date from the year, month, and day.
DateValue([date])	Long from a date usable to determine the difference between dates.
Month(Number)	Day of month from a time generated by DateSerial or DateValue.
GetSystemTicks()	Returns the system ticks provided by the operating system.
Hour(Number)	Hour from a time generated by TimeSerial or TimeValue.
Minute(Number)	Minute from a time generated by TimeSerial or TimeValue.
Month(Number)	Month from a time generated by DateSerial or DateValue.
Now	Current system date and time as a Date value.
Second(Number)	Second from a time generated by TimeSerial or TimeValue.
Time	Current system time
Timer	Number of seconds that have elapsed since midnight.
TimeSerial (h, m, s)	Serial time value from the specified hour, minute, and second.
TimeValue (s$)	Serial time value from a formatted string.
Wait millisec	Pause for the given number of milliseconds
WeekDay(Number)	Day of week from a time generated by DateSerial or DateValue.
Year(Number)	Year from a time generated by DateSerial or DateValue.

File Manipulations

Function	Description
ChDir (s$)	Changes the current directory or drive.
ChDrive(s$)	Changes the current drive.
Close #n% [, #n2%[,...]]	Close files opened with the Open statement.
ConvertFromURL(s$)	Converts a file URL to a system file name.
ConvertToURL(s$)	Converts a system file name to a file URL.
CurDir([s$])	Returns the current directory of the specified drive.
Dir [s$ [, Attrib%]]	Perform a directory listing.
EOF(n%)	Has the file pointer reached the end of the file?
FileAttr (n%, Attribut%)	Return the file attribute of an open file.
FileCopy from$, to$	Copy a file.
FileDateTime(s$)	Return a string of the file date and time.
FileExists(s$)	Determine if a file or directory exists.
FileLen (s$)	Length of file in bytes.
FreeFile	Next available file number. Prevents simultaneous use.
Get [#]n%, [Pos], v	Read a record or bytes from a file.
GetAttr(s$)	Returns a bit pattern which identifies the file type.
Input #n% v1[, v2[, [,...]]	Read data from an open sequential file.
Kill f$	Delete a file form a disk.
Line Input #n%, v$	Read a string from a sequential file into a variable.
Loc (FileNumber)	Returns the current position in an open file.
Lof (FileNumber)	Returns the current size of an open file.
MkDir s$	Create a new directory.
Name old$, new$	Rename an existing file or directory.
Open s$ [#]n%	Open a file. Most parameters not listed, this is very flexible.
Put [#] n%, [pos], v	Writes a record a sequence of bytes to a file.
Reset	Closes all open files and flushes all buffers to disk.
RmDir f$	Remove a directory.
Seek[#]n%, Pos	Move the file pointer.
SetAttr f$, Attribute%	Set the file attributes.
Write [#]n%, [Exprs]	Write data to a sequential file.

Operators, Statements, and Functions

Subtraction operator (-)

Summary:

Subtract two numerical values. The standard mathematical precedence is used as shown on page 249.

Syntax:

Result = Expression1 - Expression2

Parameter:

Result : Result of the subtraction.

Expression1, Expression2 : Any numerical expressions.

Example:

Sub SubtractionExample

Print 4 – 3 '1

Print 1.23e2 – 23 '100

End Sub

Multiplication operator (*)

Summary:

Multiply two numerical values. The standard mathematical precedence is used as shown on page 249.

Syntax:

Result = Expression1 * Expression2

Parameter:

Result : Result of the multiplication.

Expression1, Expression2 : Any numerical expressions.

Example:

Sub MultiplictionExample

Print 4 * 3 '12

Print 1.23e2 * 23 '2829

End Sub

Addition operator (+)

Summary:

Add two numerical values. Although this works with boolean values because they are represented as integers I recommend against it. Experimentally, it appears to mimic the result of the Or operator but I recommend against it because conversion may yield problems. The operations are done in the integer domain and then converted back to a boolean. This may yield problems. The standard mathematical precedence is used as shown on page 249.

Syntax:

Result = Expression1 + Expression2

Parameter:

Result : Result of the addition.

Expression1, Expression2 : Any numerical expressions.

Example:

Sub SubtractionExample

Print 4 – 3 '1

Print 1.23e2 – 23 '100

End Sub

Power operator (^)

Summary:

Raise a number to a power. Let the equation represents the operator. If z is an integer, then x is the result of multiplying y by itself z times. The standard mathematical precedence is used as shown on page 249.

Syntax:

Result = Expression ^ Exponent

Parameter:

Result : Result of the exponentiation.

Expression: Any numerical expression.

Exponent: Any numerical expression.

Example:

Sub ExponentiationExample

Print 2 ^ 3 '8

Print 2.2 ^ 2 '4.84

Print 4 ^ 0.5 '2

End Sub

Division operator (/)

Summary:

Divide two numerical values. Be careful with the results because a division may not produce an integer result when you expect one. Use the Int() function if this is important. The standard mathematical precedence is used as shown on page 249.

Syntax:

Result = Expression1 / Expression2

Parameter:

Result : Result of the division.

Expression1, Expression2 : Any numerical expressions.

Example:

Sub DivisionExample

Print 4 /2 '2

Print 11/2 '5.5

End Sub

AND Operator

Summary:

Perform a logical AND on boolean values and a bitwise AND on numerical values. A bitwise AND on a double, appears to cause a conversion to an integer type. Numerical overflow is possible. The standard mathematical precedence is used as shown on page 249 and the operation table is shown below.

x	y	x AND y
TRUE	TRUE	TRUE
TRUE	FALSE	FALSE
FALSE	TRUE	FALSE
FALSE	FALSE	FALSE
1	1	1
1	0	0
0	1	0
0	0	0

Syntax:

Result = Expression1 AND Expression2

Parameter:

Result : Result of the operation.

Expression1, Expression2 : Numerical or Boolean expression.

Example:

Sub AndExample

Print (3 AND 1) 'Prints 1

Print (True AND True) 'Prints -1

Print (True AND False) 'Prints 0

End Sub

Abs Function

Summary:

Return the absolute value of a numeric expression. If the parameter is a string, it is first converted to a number, probably using the Val function. If the number is non-negative, then it is returned, otherwise, the negative of the number is returned.

Syntax:

Abs (Number)

Return value:

Double

Parameter:

Number: Any numeric expression.

Example:

Sub AbsExample

Print Abs(3) '3

Print Abs(-4) '4

Print Abs("-123") '123

End Sub

Array Function

Summary:

Create a Variant array from the parameter list. This is the quickest method to create an array of constants.

Warning	If you assign the returned Variant array to a non-Variant array, you can not preserve the data if you re-dimension the array. I consider it a bug that you can assign the Variant array to a non-Variant array.

See also the DimArray Function.

Syntax:

Array (Argument list)

Return value:

Variant array containing the argument list.

Parameter:

Argument list: List of values separated by commas from which to create a list.

Example:

Sub ArrayExample

Dim a(5) As Integer

Dim b() As Variant

Dim c() As Integer

REM Array() returns a variant type

REM b is dimensioned from 0 to 9 where b(i) = i+1

b = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)

PrintArray("b at initial assignment", b())

REM b is dimensioned from 1 to 3 where b(i) = i+1

ReDim Preserve b(1 To 3)

PrintArray("b after ReDim", b())

REM The following is NOT valid because the array is already dimensioned

REM to a different size, but you can ReDim it, go figure!

REM a = Array(0, 1, 2, 3, 4, 5)

REM c is dimensioned from 0 to 5.

REM This concerns me because "Hello" is a String value, but

REM it is allowed as of 1.0.2

c = Array(0, 1, 2, "Hello", 4, 5)

PrintArray("c, Variant assigned to an Integer array", c())

REM Ironically, this allowed but c will contain no data!

ReDim Preserve c(1 To 3) As Integer

PrintArray("c after ReDim", c())

End Sub

Sub PrintArray (lead$, a() As Variant)

Dim i%, s$

s$ = lead$ + Chr(13) + LBound(a()) + " to " + UBound(a()) + ":" + Chr(13)

For i% = LBound(a()) To UBound(a())

s$ = s$ + a(i%) + " "

Next

REM I MsgBox rather than Print because I have an embeded Chr(13)

MsgBox s$

End Sub

Asc Function

Summary:

Return the ASCII value (American Standard Code for Information Interchange) of the first character in a string, the rest are ignored. A run-time error is reported if the string has zero length. 16 bit Unicode characters are allowed. This is essentially the inverse of the CHR$ function.

Syntax:

Asc (Text As String)

Return value:

Integer

Parameter:

Text: Any valid string expression.

Example:

Sub AscExample

Print Asc("ABC") '65

End Sub

ATN Function

Summary:

Arctangent of a numeric expression with a return value in the range -π/2 to π/2 (radians). This is the inverse of the tangent (Tan) function. For the non-mathematically minded, this is a trigonometric function.

Syntax:

ATN(Number)

Return value:

Double

Parameter:

Number:

Example:

Sub ExampleATN

Dim dLeg1 As Double, dLeg2 As Double

dLeg1 = InputBox("Enter the length of the adjacent leg: ","Adjacent")

dLeg2 = InputBox("Enter the length of the opposite leg: ","Opposite")

MsgBox "The Angle is " + Format(ATN(dLeg2/dLeg1), "##0.0000") _

+ " radians" + Chr(13) + "The Angle is " _

+ Format(ATN(dLeg2/dLeg1) * 180 / Pi, "##0.0000") + " degrees"

End Sub

Beep Statement

Summary:

Generate a system beep (sound).

Syntax:

Beep

Example:

Sub ExampleBeep

Beep

Beep

End Sub

Blue Function

Summary:

Colors are represented by a long integer. Return the blue component of the specified color code. See also RGB, Red, and Green.

Syntax:

Blue (Color As Long)

Return value:

Integer in the range of 0 to 255.

Parameter:

Color value: Long integer expression representing a color.

Example:

Sub ExampleColor

Dim lColor As Long

lColor = RGB(255,10,128)

MsgBox "The color " & lColor & " consists of:" & Chr(13) &_

"Red = " & Red(lColor) & Chr(13)&_

"Green= " & Green(lColor) & Chr(13)&_

"Blue= " & Blue(lColor) & Chr(13) , 64,"Colors"

End Sub

ByVal Keyword

Summary:

Parameters to user defined subroutines and functions are passed by reference. If the subroutine or function modifies the parameter, it is also modified in the calling program. This can cause strange results if the calling parameter is a constant or if the caller does not expect it. The ByVal keyword specifies that the parameter should be passed by value and not by reference.

Syntax:

Sub Name(ByVal ParmName As ParmType)

Example:

Sub ExampleByVal

Dim j As Integer

j = 10

ModifyParam(j)

Print j REM 9

DoNotModifyParam(j)

Print j REM 9

End Sub

Sub ModifyParam(i As Integer)

i = i - 1

End Sub

Sub DoNotModifyParam(ByVal i As Integer)

i = i - 1

End Sub

Call Keyword

Summary:

Transfers program control to a sub, function or DLL procedure. The Call is optional unless a DLL in which case it must first be defined. The parameters may be enclosed in parenthesis and they must be enclosed in parenthesis is a function is executed as an expression.

See Also: Declare

Syntax:

[Call] Name [Parameter]

Parameter:

Name: Name of the sub, function or DLL to call

Parameter: The type and number of parameters is dependent on the called routine.

Example:

Sub ExampleCall

Call CallMe "This text will be displayed"

End Sub

Sub CallMe(s As String)

Print s

End Sub

CBool Function

Summary:

Convert the parameter to a boolean. If the expression is a numeric, 0 maps to False and anything else maps to True. If the expression evaluates to a String, then “true” and “false” (case insensitive) map to True and False. Strings with any other value generate a run time error. This is useful to force the result to be a boolean. If I call a function that returns a number, such as InStr, I could write “If CBool(InStr(s1, s2)) Then” rather than “If InStr(s1, s2) <> 0 Then”.

Syntax:

CBool (Expression)

Return value:

Boolean

Parameter:

Expression: Numeric, Boolean,

Example:

Sub ExampleCBool

Print CBool(1.334e-2) 'True

Print CBool("TRUE") 'True

Print CBool(-10 + 2*5) 'False

Print CBool("John" <> "Fred")'True

End Sub

CByte Function

Summary:

Convert a string or a numeric expression to the type Byte. String expressions are converted to a numeric and doubles are rounded. If the expression is too large or negative, an error is generated.

Syntax:

Cbyte( expression )

Return value:

Byte

Parameter:

Expression : a string or a numeric expression.

Example:

Sub ExampleCByte

Print Int(CByte(133)) '133

Print Int(CByte("AB")) '0

'Print Int(CByte(-11 + 2*5))'Error, out of range

Print Int(CByte(1.445532e2))'145

Print CByte(64.9) 'A

Print CByte(65) 'A

Print Int(CByte("12")) '12

End Sub

CDate Function

Summary:

Convert to a Date. Numeric expressions contain the date, beginning from December 31, 1899 to the left of the decimal and time to the right of the decimal. String expressions must be formatted as defined by the DateValue and TimeValue function conventions. In other words, the string formatting is locale dependent. CDateFromIso is not dependent on your locale so it safer if you desire to code globally.

Syntax:

CDate (Expression)

Return value:

Date

Parameter:

Expression: Any string or numeric expression to be converted.

Example:

sub ExampleCDate

MsgBox cDate(1000.25) REM 09.26.1902 06:00:00

MsgBox cDate(1001.26) REM 09.27.1902 06:14:24

Print DateValue("06/08/2002")

MsgBox cDate("06/08/2002 15:12:00")

end sub

CDateFromIso Function

Summary:

Returns the internal date number from a string containing a date in ISO format.

Syntax:

CDateFromIso(String)

Return value:

Internal date number

Parameter:

String : a string containing an ISO date. The year may have two or four figures.

Example:

sub ExampleCDateFromIso

MsgBox cDate(37415.70) REM 08 June 2002 16:48:00

Print CDateFromIso("20020608") REM 08 June 2002

Print CDateFromIso("020608") REM 08 June 1902

Print Int(CDateFromIso("20020608")) REM 37415

end sub

CDateToIso Function

Summary:

Return the date in ISO format from a serial date number generated with DateSerial or DateValue.

Syntax:

CDateToIso(Number)

Return value:

String

Parameter:

Number : Integer that contains the serial date number.

Example:

Sub ExampleCDateToIso

MsgBox "" & CDateToIso(Now) ,64,"ISO Date"

End Sub

CDbl Function

Summary:

Converts any numerical expression or string expression to a double type. Strings must be formatted based on the locale. In the USA, “12.34” will work but this will fail elsewhere.

Syntax:

CDbl (Expression)

Return value:

Double

Parameter:

Expression : Any string or numeric expression to be converted.

Example:

Sub ExampleCDbl

Msgbox CDbl(1234.5678)

Msgbox CDbl("1234.5678")

End Sub

ChDir statement is deprecated

Summary:

Change the current directory or drive. If you only want to change the current drive, enter the drive letter followed by a colon. The ChDir statement is deprecated, do not use it.

Syntax:

ChDir(Text)

Parameter:

Text: Any string expression that specifies the directory path or drive.

Example:

Sub ExampleChDir

Dim sDir as String

sDir = CurDir

ChDir( "C:\temp" )

msgbox CurDir

ChDir( sDir )

msgbox CurDir

End Sub

ChDrive statement is deprecated

Summary:

Change the current drive. The drive letter must be expressed as an uppercase letter. You may use the OnError statement to catch any errors. This is deprecated, do not use this.

Syntax:

ChDrive(Text)

Parameter:

Text: String expression containing the drive letter. URL notation is accepted.

Example:

Sub ExampleCHDrive

On Local Error Goto NoDrive

ChDrive "Z" REM Only possible if a drive 'Z' exists.

Print "Completed"

Exit Sub

NoDrive:

Print "Sorry, the drive does not exist"

Resume Next

End Sub

Choose Function

Summary:

Return a selected value from a list of arguments. This is a quick method to select a value from a list. If the index is out of bounds (less than 1 or greater than n), then a null is returned.

Syntax:

Choose (Index, Selection_1[, Selection_2, ... [,Selection_n]])

Return value:

The type will be whatever type Selection_i happens to be.

Parameter:

Index: A numeric expression specifying the value to return.

Selection_i: A value to return.

Example:

In this example, the variable “o” is not given a type so it takes the type of Selection_i. Selection_1 is type “String” and Selection_2 is type Double. If I define “o” to have a type, then the return value is cast to that type.

Sub ExampleChoose

Dim sReturn As String

Dim sText As String

Dim i As Integer

Dim o

sText = InputBox ("Enter a number (1-3):","Example")

i = Int(sText)

o = Choose(i, "One", 2.2, "Three")

If IsNull(o) Then

Print "Sorry, '" + sText + "' is not valid"

Else

Print "Obtained '" + o + "' of type " + TypeName(o)

End If

end Sub

Chr Function

Summary:

Return the character corresponding to the specified character (ASCII or Unicode) code.

This is used to create special string sequences such as control codes to send to printers, tabs, new lines, carriage returns, etc. This also provides a method to insert a double quote into a string. This is sometimes written as “Chr$()”.

See Also the Asc Function.

Syntax:

Chr(Expression)

Return value:

String

Parameter:

Expression: Numeric variables representing a valid 8 bit ASCII value (0-255) or a 16 bit Unicode value.

Example:

Example:

sub ExampleChr

REM Show "Line 1" and "Line 2" on separate lines.

MsgBox "Line 1" + Chr$(13) + "Line 2"

End Sub

CInt Function

Summary:

Converts any numerical expression or string expression to an Integer type. Strings must be formatted based on the locale. In the USA, “12.34” will work.

See Also: Fix

Syntax:

CInt(Expression)

Return value:

Integer

Parameter:

Expression : Any string or numeric expression to be converted.

Example:

Sub ExampleCInt

Msgbox CInt(1234.5678)

Msgbox CInt("1234.5678")

End Sub

CLng Function

Summary:

Converts any numerical expression or string expression to Long type. Strings must be formatted based on the locale. In the USA, “12.34” will work.

Syntax:

CLong(Expression)

Return value:

Long

Parameter:

Expression : Any string or numeric expression to be converted.

Example:

Sub ExampleCLng

Msgbox CLng(1234.5678)

Msgbox CLng("1234.5678")

End Sub

Close Statement

Summary:

Close files previously opened with the Open statement. Multiple files may be closed simultaneously.

See also Open, EOF, Kill, and FreeFile

Syntax:

Close #FileNumber As Integer[, #FileNumber2 As Integer[,...]]

Parameter:

FileNumber : Integer expression that specifies a previously opened file.

Example:

Sub ExampleCloseFile

Dim iNum1 As Integer, iNum2 As Integer

Dim sLine As String, sMsg As String

'Next available file number!

iNum1 = FreeFile

Open "c:\data1.txt" For Output As #iNum1

iNum2 = FreeFile

Open "c:\data2.txt" For Output As #iNum2

Print #iNum1, "Text in file one for number " + iNum1

Print #iNum2, "Text in file two for number " + iNum2

Close #iNum1, #iNum2

Open "c:\data1.txt" For Input As #iNum1

iNum2 = FreeFile

Open "c:\data2.txt" For Input As #iNum2

sMsg = ""

Do While not EOF(iNum1)

Line Input #iNum1, sLine

If sLine <> "" Then sMsg = sMsg+"File: "+iNum1+":"+sLine+Chr(13)

Loop

Close #iNum1

Do While not EOF(iNum2)

Line Input #iNum2, sLine

If sLine <> "" Then sMsg = sMsg+"File: "+iNum2+":"+sLine+Chr(13)

Loop

Close #iNum2

Msgbox sMsg

End Sub

Const Statement

Summary:

Constants improve the readability of a program by assigning names to constants and also by providing a single point of definition. Constants may include a type definition but this is not required. A constant is defined once and can not be modified.

Syntax:

Const Text [As type] = Expression[, Text2 [As type] = Expression2[, ...]]

Parameter:

Text: Any constant name which follows the standard variable naming conventions.

Example:

Sub ExampleConst

Const iVar As String = 1964

Const sVar = "Program", dVar As Double = 1.00

Msgbox iVar & " " & sVar & " " & dVar

End Sub

ConvertFromURL Function

Summary:

Converts a file URL to a system file name.

Syntax:

ConvertFromURL(filename)

Return value:

String

Parameter:

Filename: File name as a URL

Example:

Sub ExampleFromUrl

Dim s$

s = "file:///c:/temp/file.txt"

MsgBox s & " => " & ConvertFromURL(s)

s = "file:///temp/file.txt"

MsgBox s & " => " & ConvertFromURL(s)

End Sub

ConvertToURL Function

Summary:

Converts a system file name to a URL.

Syntax:

ConvertToURL(filename)

Return value:

String

Parameter:

Filename: File name as a system name.

Example:

Sub ExampleToUrl

Dim s$

s = "c:\temp\file.txt"

'file:///c:/temp/file.txt

MsgBox s & " => " & ConvertToURL(s)

s = "\temp\file.txt"

'file:///temp/file.txt

MsgBox s & " => " & ConvertToURL(s)

End Sub

Cos Function

Summary:

Cosine of a numeric expression with a return value in the range -1 to 1.For the non-mathematically minded, this is a trigonometric function.

Syntax:

Cos(Number)

Return value:

Double

Parameter:

Number:

Example:

Sub ExampleCos

Dim dLeg1 As Double, dLeg2 As Double, dHyp As Double

Dim dAngle As Double

dLeg1 = InputBox("Enter the length of the adjacent leg: ","Adjacent")

dLeg2 = InputBox("Enter the length of the opposite leg: ","Opposite")

dHyp = Sqr(dLeg1 * dLeg1 + dLeg2 * dLeg2)

dAngle = Atn(dLeg2 / dLeg1)

MsgBox "Adjacent Leg = " + dLeg1 + Chr(13) + _

"Opposite Leg = " + dLeg2 + Chr(13) + _

"Hypotenuse = " + Format(dHyp, "##0.0000") + Chr(13) + _

"Angle = "+Format(dAngle*180/Pi, "##0.0000")+" degrees"+Chr(13)+_

"Cos = " + Format(dLeg1 / dHyp, "##0.0000") + Chr(13) + _

"Cos = " + Format(Cos(dAngle), "##0.0000")

End Sub

CreateUnoDialog Function

Summary:

Create a Basic UNO object that represents a UNO dialog control during Basic runtime.

Dialogs are defined in the dialog libraries. To display a dialog, a "live" dialog must be created from the library.

Syntax:

CreateUnoDialog( oDlgDesc )

Return value:

Object: Dialog to execute!

Parameter:

oDlgDesc : Dialog description previously defined in a library.

Example:

Sub ExampleCreateDialog

Dim oDlgDesc As Object, oDlgControl As Object

DialogLibraries.LoadLibrary("Standard")

' Get dialog description from the dialog library

oDlgDesc = DialogLibraries.Standard

Dim oNames(), i%

oNames = DialogLibraries.Standard.getElementNames()

i = lBound( oNames() )

while( i <= uBound( oNames() ) )

MsgBox "How about " + oNames(i)

i = i + 1

wend

oDlgDesc = DialogLibraries.Standard.Dialog1

' generate "live" dialog

oDlgControl = CreateUnoDialog( oDlgDesc )

' display "live" dialog

oDlgControl.execute

End Sub

CreateUnoService Function

Summary:

Instantiates an UNO service with the ServiceManager.

Syntax:

oService = CreateUnoService( UNO service name )

Return value:

The requested service.

Parameter:

String name of the requested service

Example:

This example was provided by Laurent Godard. Like him, I was unable to figure out how to include text in the email message because as of 1.1.1, you can not include text. The mail service was created to send attachments, hopefully this will be fixed or changed in the figure.

Sub SendSimpleMail()

Dim vMailSystem, vMail, vMessage

vMailSystem=createUnoService("com.sun.star.system.SimpleSystemMail")

vMail=vMailSystem.querySimpleMailClient()

'You want to know what else you can do with this, see

'http://api.openoffice.org/docs/common/ref/com/sun/star/system/XSimpleMailMessage.html

vMessage=vMail.createsimplemailmessage()

vMessage.setrecipient("Andrew.Pitonyak@qwest.com")

vMessage.setsubject("This is my test subject")

'Attachements are set by a sequence which in basic means an array

'I could use ConvertToURL() to build the URL!

Dim vAttach(0)

vAttach(0) = "file:///c|/macro.txt"

vMessage.setAttachement(vAttach())

'DEFAULTS Launch the currently configured system mail client.

'NO_USER_INTERFACE Do not show the interface, just do it!

'NO_LOGON_DIALOG No logon dialog but will throw an exception if one is required.

vMail.sendSimpleMailMessage(vMessage, com.sun.star.system.SimpleMailClientFlags.NO_USER_INTERFACE)

End Sub

CreateUnoStruct Function

Summary:

Create an instance of an UNO structure type.

For com.sun.star.beans.PropertyValue it is better to use the following construct!

Dim oStruct As New com.sun.star.beans.PropertyValue

Syntax:

oStruct = CreateUnoStruct( UNO type name )

Parameter:

String name of the requested structure.

Return value:

The requested structure

Example:

oStruct = CreateUnoStruct("com.sun.star.beans.PropertyValue")

'***********************************

'Do you want to choose a certain printer

'Dim mPrinter(0) As New com.sun.star.beans.PropertyValue

'mPrinter(0).Name="Name"

'mPrinter(0).value="Other printer"

'oDocument.Printer = mPrinter()

'You could have done it this way after it was defined!

'mPrinter(0) = CreateUnoStruct("com.sun.star.beans.PropertyValue")

CSng Function

Summary:

Converts any numerical expression or string expression to Single type. Strings must be formatted based on the locale. In the USA, “12.34” will work.

Syntax:

CSng(Expression)

Return value:

Single

Parameter:

Expression : Any string or numeric expression to be converted.

Example:

Sub ExampleCLng

Msgbox CSng(1234.5678)

Msgbox CSng("1234.5678")

End Sub

CStr Function

Summary:

Convert any expression to a string expression. This is usually used to convert a number to a string.

Input Type	Output Value
Boolean	“True” or “False”
Date	String with the date and time
Null	run-time error
Empty	empty string “”
Any Number	The number as a string. Trailing zeros to the right of the decimal are dropped.

Syntax:

CStr (Expression)

Return value:

String

Parameter:

Expression: Any valid string or numeric expression to be converted.

Example:

Sub ExampleCSTR

Dim sVar As String

Msgbox CDbl(1234.5678)

Msgbox CInt(1234.5678)

Msgbox CLng(1234.5678)

Msgbox CSng(1234.5678)

sVar = CStr(1234.5678)

MsgBox sVar

end sub

CurDir Function

Summary:

Return the String representing the current path of the specified drive. If the parameter is missing or zero-length, then the path for the current drive is returned. This function is currently broken! On my machine it always returns the OOo /program/ .

Syntax:

CurDir [(Text As String)]

Return value:

String

Parameter:

Text: Optional case-insensitive string expression specifying an existing drive for which to return the current path. This should be a single character.

Example:

Sub ExampleCurDir

MsgBox CurDir("c")

MsgBox CurDir("p")

MsgBox CurDir()

end sub

Date Function

Summary:

Return or change the current system date. The date format is locale-dependent.

Syntax:

Date

Date = Text As String

Return value:

String

Parameter:

Text: New system date as defined in your locale settings.

Example:

Sub ExampleDate

MsgBox "The date is " & Date

End Sub

DateSerial Function

Summary:

Convert a year, month, and day to a Date object. The internal representation is a Double where 0 is December 30,1899. View this double as the number of days from this base date. Negative numbers are before and positive numbers are after.

See also DateValue, Date, and Day.

Warning	Two digit years are considered 19xx. This is not consistent with the DateValue function.

Syntax:

DateSerial (year, month, day)

Return value:

Date

Parameter:

Year: Integer year. Values between 0 and 99 are interpreted as the years 1900 to 1999. All other years must contain four digits.

Month: Integer indicating the month. Valid values from 1 to 12.

Day: Integer indicating the day. Valid values from 1 to 28, 29, 30 or 31 (month dependent).

Example:

Sub ExampleDateSerial

Dim lDate as Long, sDate as String, lNumDays As Long

lDate = DateSerial(2002, 6, 8)

sDate = DateSerial(2002, 6, 8)

MsgBox lDate REM returns 37415

MsgBox sDate REM returns 06/08/2002

lDate = DateSerial(02, 6, 8)

sDate = DateSerial(02, 6, 8)

MsgBox lDate REM returns 890

MsgBox sDate REM returns 06/08/1902

end sub

DateValue Function

Summary:

Convert a date string to a single numeric value usable to determine the number of days between two dates.

See also DateSerial, Date, and Day

Warning	Two digit years are considered 20xx. This is not consistent with the DateSerial function.

Syntax:

DateValue [(date)]

Return value:

Long

Parameter:

Date: String representation of the date.

Example:

Sub ExampleDateValue

Dim s(), i%, sMsg$, l1&, l2&

REM These all map to June 8, 2002.

s = Array("06.08.2002", "6.08.02", "6.08.2002", "June 08, 2002", _

"Jun 08 02", "Jun 08, 2002", "Jun 08, 02", "06/08/2002")

REM If you use these values, it will generate an error

REM which contradicts the included help

REM s = Array("6.08, 2002", "06.08, 2002", "06,08.02", "6,08.2002", "Jun/08/02")

sMsg = ""

For i = LBound(s()) To UBound(s())

sMsg = sMsg + DateValue(s(i)) + "<=" + s(i) + Chr(13)

Next

MsgBox sMsg

Print "I was married " + (DateValue(Date) - DateValue("6/8/2002")) + " days ago"

end sub

Day Function

Summary:

Return the day of the month based on a serial date number generated with DateSerial or DateValue.

Syntax:

Day (Number)

Return value:

Integer

Parameter:

Number: Serial date number such as returned by DateSerial

Example:

Sub ExampleDay

Print Day(DateValue("6/8/2002") REM 8

Print Day(DateSerial(02,06,08)) REM 8

end sub

Declare Statement

Summary:

Used to declare and define a subroutine in a DLL (Dynamic Link Library) to be executed from OpenOffice.org Basic. The ByVal keyword must be used if parameters are to be passed by value rather than by reference.

See also: FreeLibrary, Call

Syntax:

Declare {Sub | Function} Name Lib "Libname" [Alias "Aliasname"] [Parameter] [As Type]

Parameter/Element:

Name: A different name than defined in the DLL, used to call the subroutine from Basic.

Aliasname: Name of the subroutine as defined in the DLL.

Libname: File or system name of the DLL. This library is automatically loaded the first time the function is used.

Argumentlist: List of parameters representing arguments that are passed to the procedure when it is called. The type and number of parameters is dependent on the executed procedure.

Type: Defines the data type of the value returned by a Function procedure. This can be excluded if a type-declaration character is entered after the name.

Example:

Declare Sub MyMessageBeep Lib "user32.dll" Alias "MessageBeep" ( long )

Sub ExampleDeclare

Dim lValue As Long

lValue = 5000

MyMessageBeep( lValue )

FreeLibrary("user32.dll" )

End Sub

DefBool Statement

Summary:

Set the default variable type, according to a letter range, if no type-declaration character or keyword is specified. You can allow all variables that start with a “b”, for example, to automatically be of type Boolean.

See also: DefBool, DefDate, DefDbL, DefInt, DefLng, DefObj, and DefVar.

Syntax:

DefBool CharacterRange1[, CharacterRange2[,...]]

Parameter:

CharacterRange: Letters specifying the range of variables for which to set a default data type.

Example:

REM Prefix definition for variable types:

DefBool b

DefDate t

DefDbL d

DefInt i

DefLng l

DefObj o

DefVar v

DefBool b-d,q

Sub ExampleDefBool

cOK = 2.003

zOK = 2.003

Print cOK REM True

Print zOK REM 2.003

End Sub

DefDate Statement

Summary

Set the default variable type, according to a letter range, if no type-declaration character or keyword is specified. You can allow all variables that start with a “t”, for example, to automatically be of type Date.

See also: DefBool, DefDate, DefDbL, DefInt, DefLng, DefObj, and DefVar.

Syntax:

DefDate Characterrange1[, Characterrange2[,...]]

Parameter:

Characterrange: Letters specifying the range of variables for which to set a default data type.

Example:

See ExampleDefBool

DefDbl Statement

Summary

Set the default variable type, according to a letter range, if no type-declaration character or keyword is specified. You can allow all variables that start with a “d”, for example, to automatically be of type Double.

See also: DefBool, DefDate, DefDbL, DefInt, DefLng, DefObj, and DefVar.

Syntax:

DefDbl Characterrange1[, Characterrange2[,...]]

Parameter:

Characterrange: Letters specifying the range of variables for which to set a default data type.

Example:

See ExampleDefBool

DefInt Statement

Summary

Set the default variable type, according to a letter range, if no type-declaration character or keyword is specified. You can allow all variables that start with a “ii”, for example, to automatically be of type Integer.

See also: DefBool, DefDate, DefDbL, DefInt, DefLng, DefObj, and DefVar.

Syntax:

DefInt Characterrange1[, Characterrange2[,...]]

Parameter:

Characterrange: Letters specifying the range of variables for which to set a default data type.

Example:

See ExampleDefBool

DefLng Statement

Summary

Set the default variable type, according to a letter range, if no type-declaration character or keyword is specified. You can allow all variables that start with a “l”, for example, to automatically be of type Long.

See also: DefBool, DefDate, DefDbL, DefInt, DefLng, DefObj, and DefVar.

Syntax:

DefLng Characterrange1[, Characterrange2[,...]]

Parameter:

Characterrange: Letters specifying the range of variables for which to set a default data type.

Example:

See ExampleDefBool

DefObj Statement

Summary

Set the default variable type, according to a letter range, if no type-declaration character or keyword is specified. You can allow all variables that start with a “o”, for example, to automatically be of type Object.

See also: DefBool, DefDate, DefDbL, DefInt, DefLng, DefObj, and DefVar.

Syntax:

DefObj Characterrange1[, Characterrange2[,...]]

Parameter:

Characterrange: Letters specifying the range of variables for which to set a default data type.

Example:

See ExampleDefBool

DefVar Statement

Summary

Set the default variable type, according to a letter range, if no type-declaration character or keyword is specified. You can allow all variables that start with a “v”, for example, to automatically be of type Variant.

See also: DefBool, DefDate, DefDbL, DefInt, DefLng, DefObj, and DefVar.

Syntax:

DefVar Characterrange1[, Characterrange2[,...]]

Parameter:

Characterrange: Letters specifying the range of variables for which to set a default data type.

Example:

See ExampleDefBool

Dim Statement

Summary:

Declare variables. The type of each variable is declared separately and the default type is Variant. The following defines a, b, and c to be of type Variant and d to be of type Date.

Dim a, b, c, d As Date

A variables type may also be specified by the use of an appended character. This is mentioned in the section on variable types.

Dim is used to declare local variables within Subs. Global variables outside of Subs are declared with the PUBLIC or PRIVATE statements.

Unless the “Option Explicit” statement is present, non-array variables may be used without declaration and their default type is variant.

Single and multi-dimensional arrays are supported.

See also: Public, Private, ReDim

Syntax:

[ReDim]Dim Name_1 [(start To end)] [As Type][, Name_2 [(start To end)] [As Type][,...]]

Parameter/Keyword:

Name_i: Variable or array name.

Start, End: Integer constants from -32768 to 32767 an inclusive array range. At the procedural level, the ReDim allows numerical expressions so these may be reset at runtime.

Type: Key word used to declare the data type of a variable. The supported variable types are Boolean, Currency, Date, Double, Integer, Long, Object, Single, String, or Variant.

Example:

Sub ExampleDim

Dim s1 As String, i1 As Integer, i2%

Dim a1(5) As String REM 0 to 6

Dim a2(3, -1 To 1) As String REM (0 to 3, -1 to 1)

Const sDim as String = " Dimension:"

For i1 = LBound(a2(), 1) To UBound(a2(), 1)

For i2 = LBound(a2(), 2) To UBound(a2(), 2)

a2(i1, i2) = Str(i1) & ":" & Str(i2)

Next

Next

For i1 = LBound(a2(), 1) To UBound(a2(), 1)

For i2 = LBound(a2(), 2) To UBound(a2(), 2)

Print a2(i1, i2)

Next

Next

End Sub

DimArray Function

Summary:

Create a Variant array. This works just like Dim(Argument list). If no arguments are present, an empty array is created. If parameters are present, a dimension is created for each parameter.

See also: Array

Syntax:

DimArray ( Argument list)

Return value:

Variant array

Parameter:

Argument list: Optional comma separated list of integers.

Example:

DimArray( 2, 2, 4 ) is the same as DIM a( 2, 2, 4 )

Dir Function

Summary:

Return the name of a file, directory, or all files and folders of a drive or directory that match the specified search path. Possible uses include verifying that a file or directory exists, or to list the files and folders in a specific directory.

If no files or directories match, a zero length string is returned. Repeatedly call the Dir function until a zero length string is returned to iterate through all of the return values.

The volume and directory attributes are exclusive meaning that if you request one of these it is the only thing that you will retrieve. I can not determine which has greater precedence because as of 1.0.3, the volume attribute does nothing.

The attributes are a subset of those available in GetAttr.

See Also: GetAttr

Syntax:

Dir [(Text As String[, Attrib As Integer])]

Return value:

String

Parameter:

Text: String that specifies the search path, directory or file. The URL notation is accepted.

Attrib: Integer expression for file attributes. The Dir function returns only files or directories that match the specified attributes. Add the attributes to combine them.

Attribute	Description
0	Normal files.
2	Hidden files.
4	System files.
8	Returns the name of the volume (Exclusive).
16	Return directories (Exclusive).

Example:

Sub ExampleDir

REM Displays all files and directories

Dim sFile as String, sPath As String

Dim sDir as String, sValue as String

Dim iFIle as Integer

sFile= "Files: "

sDir="Directories:"

iFile = 0

sPath = CurDir

REM 0 : Normal files.

REM 2 : Hidden files.

REM 4 : System files.

REM 8 : Returns the name of the volume

REM 16 : Returns the name of the directory only.

REM This example will ONLY return directories because the 16 is included!

REM Remove the 16 and you will receive the files

sValue = Dir$(sPath, 0 + 2 + 4 + 16)

Do

If sValue <> "." and sValue <> ".." Then

If (GetAttr( sPath + getPathSeparator() + sValue) AND 16) > 0 Then

REM here the directories

sDir = sDir & chr(13) & sValue

Else

REM here the files

If iFile Mod 3 = 0 Then sFile = sFile + Chr(13)

iFile = iFile + 1

sFile = sFile + sValue &"; "

End If

End If

sValue = Dir$

Loop Until sValue = ""

MsgBox sDir,0,sPath

MsgBox "" & iFile & " " & sFile,0,sPath

End Sub

Tip	The method getPathSeparator() is included even though it does not appear in the help list. I have not yet found where it is defined, but it is used in the distributed tools and the help.
Warning	Some operating systems include the directories “.” and “..” which refer to the current directory and the parent directory respectively. If you write code that traverses a directory, you probably do not want to follow these or you will be stuck in an infinite loop.
Warning	When you obtain a directory listing, files are not returned, even if the on-line help example seems to indicate that it does.

Do...Loop Statement

Summary:

Construct to repeat statements.

See Also: Loop Control Page 239.

Syntax:

Do [{While | Until} condition = True]

statement block

[Exit Do]

statement block

Loop

Syntax:

Do

statement block

[Exit Do]

statement block

Loop [{While | Until} condition = True]

End Statement

Summary:

Mark the end of a procedure, block or even a subroutine or function.

See Also: Exit

Syntax:

Form	Function
End	End by itself ends program execution. It may be entered anywhere. This is optional.
End Function	Mark the end a function
End If	Mark the end of an If...Then...Else block.
End Select	Mark the end of a Select Case block.
End Sub	Mark the end a subroutine.

Example:

Sub ExampleEnd

Dim s As String

s = InputBox ("Enter an integer :","White Space Checker")

If IsWhiteSpace(Val(s)) Then

Print "ASCII " + s + " is white space"

Else

Print "ASCII " + s + " is not white space"

End If

End

Print "I will never get here"

End Sub

Function IsWhiteSpace(iChar As Integer) As Boolean

Select Case iChar

Case 9, 10, 13, 32, 160

IsWhiteSpace = True

Case Else

IsWhiteSpace = False

End Select

End Function

Environ Function

Summary:

Return the value of an environment variable. Environment variables are operating system dependent. On a Macintosh computer the function returns an empty string.

Syntax:

Environ (Environment As String)

Return value:

String

Parameter:

Environment: Environment variable for which to return the value.

Example:

Sub ExampleEnviron

MsgBox "Path = " & Environ("PATH")

End Sub

EOF Function

Summary:

Use EOF to avoid trying to read past the end of a file. When the end of the file is reached, EOF returns True (-1).

See also Open, Close, Kill, and FreeFile

Syntax:

EOF (intexpression As Integer)

Return value:

Boolean

Parameter:

Intexpression: Integer expression that evaluates to the number of an open file.

Example:

REM This example modified from the on-line help.

REM The on-line help example does not work.

Sub ExampleEof

Dim iNumber As Integer

Dim aFile As String

Dim sMsg as String, sLine As String

aFile = "c:\DeleteMe.txt"

iNumber = Freefile

Open aFile For Output As #iNumber

Print #iNumber, "First line of text"

Print #iNumber, "Another line of text"

Close #iNumber

iNumber = Freefile

Open aFile For Input As iNumber

While Not Eof(iNumber)

Line Input #iNumber, sLine

If sLine <>"" Then

sMsg = sMsg & sLine & chr(13)

End If

Wend

Close #iNumber

Msgbox sMsg

End Sub

EqualUnoObjects Function

Summary:

Test if the two UNO objects represent the same UNO object instance.

Syntax:

EqualUnoObjects( oObj1, oObj2 )

Return value:

Boolean

Example:

Sub ExampleEqualUnoObjects

Dim oIntrospection, oIntro2, Struct2

REM Copy of objects -> same instance

oIntrospection = CreateUnoService( "com.sun.star.beans.Introspection" )

oIntro2 = oIntrospection

Print EqualUnoObjects( oIntrospection, oIntro2 )

REM Copy of structs as value -> new instance

Dim Struct1 As New com.sun.star.beans.Property

Struct2 = Struct1

Print EqualUnoObjects( Struct1, Struct2 )

End Sub

EQV Operator

Summary:

Calculates the logic equivalence of two expressions. In a bit-wise comparison, the EQV operator sets the corresponding bit in the result only if a bit is set in both expressions, or neither expression. The standard mathematical precedence is used as shown on page 249 and the operation table is shown below.

x	y	x EQV y
TRUE	TRUE	TRUE
TRUE	FALSE	FALSE
FALSE	TRUE	FALSE
FALSE	FALSE	TRUE
1	1	1
1	0	0
0	1	0
0	0	1

Syntax:

Result = Expression1 EQV Expression2

Parameter:

Result: Numeric variable to contain the result of the comparison.

Expression1, expression2 : Expressions to be compared.

Example:

Sub ExampleEQV

Dim vA as Variant, vB as Variant, vC as Variant, vD as Variant

Dim vOut as Variant

vA = 10: vB = 8: vC = 6: vD = Null

vOut = vA > vB EQV vB > vC REM returns -1

Print vOut

vOut = vB > vA EQV vB > vC REM returns -1

Print vOut

vOut = vA > vB EQV vB > vD REM returns 0

Print vOut

vOut = (vB > vD EQV vB > vA) REM returns -1

Print vOut

vOut = vB EQV vA REM returns -1

End Sub

Erl Function

Summary:

Return the line number in which an error occurred during program execution.

See Also: Err

Syntax:

Erl

Return value:

Integer

Example:

Sub ExampleErl

On Error GoTo ErrorHandler

Dim iVar as Integer

iVar = 0

iVar = 4 / iVar

Exit Sub

ErrorHandler:

REM Error 11 : Division by Zero

REM In line: 8

REM ....

MsgBox "Error " & err & ": " & error$ + chr(13) + _

"In line : " + Erl + chr(13) + Now , 16 ,"An error occured"

End Sub

Err Function

Summary:

Return the error number of the last error.

See Also: Erl

Syntax:

Err

Return value:

Integer

Example:

Sub ExampleErr

On Error GoTo ErrorHandler

Dim iVar as Integer

iVar = 0

iVar = 4 / iVar

Exit Sub

ErrorHandler:

REM Error 11 : Division by Zero

REM In line: 8

REM ....

MsgBox "Error " & err & ": " & error$ + chr(13) + _

"In line : " + Erl + chr(13) + Now , 16 ,"An error occured"

End Sub

Error statement does not work as indicated.

Summary:

Simulates the occurrence of an error during program execution. This does NOT work!

Syntax:

Error errornumber As Integer

Return value:

Integer

Parameter:

Errornumber: Integer expression that specifies the number of the error to be simulated.

Example:

Error Function

Summary:

Returns the error message corresponding to a given error code.

Syntax:

Error (Expression)

Return value:

String

Parameter:

Expression: Optional integer containing the error message for an error number. If this is missing, the most recent error message is returned.

Example:

Sub ExampleError

On Error GoTo ErrorHandler

Dim iVar as Integer

iVar = 0

iVar = 4 / iVar

Exit Sub

ErrorHandler:

REM Error 11 : Division by Zero

REM In line: 8

REM ....

MsgBox "Error " & err & ": " & error$ + chr(13) + _

"In line : " + Erl + chr(13) + Now , 16 ,"An error occured"

End Sub

Exit Statement

Summary:

The Exit statement is used to leave a Do...Loop, For...Next, Function or Subroutine construct. In other words, I can immediately exit any of these constructs. If I am inside of a Sub and I determine that the arguments are bad, I can immediately leave the Sub.

See Also: End

Syntax:

Form	Function
Exit Do	Exit the inner-most Do...Loop.
Exit For	Exit the inner-most For...Next loop.
Exit Function	Exit a function and continue execution following the function call.
Exit Sub	Exit a subroutine and continue execution following the subroutine call.

Example:

Sub ExampleExit

Dim sReturn As String

Dim sListArray(10) as String

Dim siStep as Single

REM Build array ("B", "C", ..., "L")

For siStep = 0 To 10 REM Fill array with test data

sListArray(siStep) = chr(siStep + 66)

Next siStep

sReturn = LinSearch(sListArray(), "M")

Print sReturn

Exit Sub REM This really is a useless statement!

End Sub

REM Returns the index of the entry or (LBound(sList()) - 1) if not found

Function LinSearch( sList(), sItem As String ) as integer

Dim iCount As Integer

REM LinSearch searches a TextArray:sList() for a TextEntry:

For iCount=LBound(sList()) To UBound(sList())

If sList(iCount) = sItem Then

LinSearch = iCount

Exit Function REM Probably a good use of Exit here!

End If

Next

LinSearch = LBound(sList()) - 1

End Function

Exp Function

Summary:

Return the base of the natural logarithm (e = 2.718282) raised to a power.

See Also: Log

Syntax:

Exp (Number)

Return value:

Double

Parameter:

Number: Any numeric expression.

Example:

Sub ExampleExp

Dim d as Double, e As Double

e = Exp(1)

Print "e = " & e

Print "ln(e) = " & Log(e)

Print "2*3 = " & Exp(Log(2.0) + Log(3.0))

Print "2^3 = " & Exp(Log(2.0) * 3.0)

end sub

FileAttr Function

Summary:

The first purpose of the FileAttr function is to determine the access mode of file opened with the Open statement. Setting the second parameter to 1, requests this value.

Value	Access Mode Description
1	INPUT (file open for input)
2	OUTPUT (file open for output)
4	RANDOM (file open for random access)
8	APPEND (file open for appending)
32	BINARY (file open in binary mode)

The second purpose of the FileAttr function is to determine the MS-DOS file attribute of a file that was opened with the Open statement. This value is operating system dependent. Setting the second parameter to 2, requests this value.

Warning	The file attribute is operating system dependent. If the operating system is a 32-Bit-Version, it is not possible to use the FileAttr-Function to determine the MS-Dos file attribute so a zero is returned.

See Also: Open

Syntax:

FileAttr (FileNumber As Integer, Attribute As Integer)

Return value:

Integer

Parameter:

FileNumber: Number used in the Open statement.

Attribute: Integer indicating what information to return. 1 requests the access mode and 2 requests the file access number.

Example:

Sub ExampleFileAttr

Dim iNumber As Integer

iNumber = Freefile

Open "file:///c|/data.txt" For Output As #iNumber

Print #iNumber, "Random Text"

MsgBox AccessModes(FileAttr(#iNumber, 1 )),0,"Access mode"

MsgBox FileAttr(#iNumber, 2 ),0,"File attribute"

Close #iNumber

End Sub

Function AccessModes(x As Integer) As String

Dim s As String

s = ""

If (x AND 1) <> 0 Then s = "INPUT"

If (x AND 2) <> 0 Then s = "OUTPUT"

If (x AND 4) <> 0 Then s = s & " RANDOM"

If (x AND 8) <> 0 Then s = s & " APPEND"

If (x AND 32) <> 0 Then s = s & " BINARY"

AccessModes = s

End Function

FileCopy Statement

Summary:

Copy a file. You can not copy a file that is open.

Syntax:

FileCopy TextFrom As String, TextTo As String

Parameter:

TextFrom: String specifying source file name.

TextTo: String specifying the destination file name.

Example:

Sub ExampleFilecopy

Filecopy "c:\Data.txt", "c:\Temp\Data.sav"

End Sub

FileDateTime Function

Summary:

Return a string that with the date and time a file was created or last modified, returned in an system dependent format "MM/DD/YYYY HH:MM:SS" on my computer. Consider using the DateValue function with this string.

Syntax:

FileDateTime(Text As String)

Return value:

String

Parameter:

Text: File specification (no wild-cards allowed). URL notation is allowed.

Example:

Sub ExampleFileDateTime

REM 04/23/2003 19:30:03

MsgBox FileDateTime("file://localhost/C|/macro.txt")

End Sub

FileExists Function

Summary:

Determine if a file or a directory exists.

Syntax:

FileExists(FileName As String | DirectoryName As String)

Return value:

Boolean

Parameter:

FileName | DirectoryName: File or directory specification (no wild-cards allowed).

Example:

Sub ExampleFileExists

MsgBox FileExists("C:\autoexec.bat")

MsgBox FileExists("file://localhost/c|/macro.txt")

MsgBox FileExists("file:///d|/private")

End Sub

FileLen Function

Summary:

Determine the length of a file. If the file is currently open, the file length before it was opened is returned. To determine the current file length of an open file, use the Lof function instead.

Syntax:

FileLen(FileName As String)

Return value:

Long

Parameter:

FileName: File specification (no wild-cards allowed).

Example:

Sub ExampleFileExists

MsgBox FileLen("C:\autoexec.bat")

MsgBox FileLen("file://localhost/c|/macro.txt")

End Sub

FindObject Function

Summary:

Give a variable name and it will return a reference to the object. See FindPropertyObject. Running the code shown below should demonstrate that this does not work very well.

Sub TestTheThing

Dim oTst As Object

Dim oDoc As Object

oTst = FindObject("oDoc")

REM yes

If oTst IS oDoc Then Print "oTst and oDoc are the same"

oDoc = ThisComponent

oTst = FindObject("oDoc")

REM no

If oTst IS oDoc Then Print "oTst and oDoc are the same"

REM no

If oTst IS ThisComponent Then Print "oTst and ThisComponent are the same"

REM yes

If oDoc IS ThisComponent Then Print "oDoc and ThisComponent are the same"

oDoc = ThisComponent

oTst = FindObject("ThisComponent")

REM yes

If oTst IS oDoc Then Print "oTst and oDoc are the same"

REM yes

If oTst IS ThisComponent Then Print "oTst and ThisComponent are the same"

REM yes

If oDoc IS ThisComponent Then Print "oDoc and ThisComponent are the same"

REM this shows ThisComponent

RunSimpleObjectBrowser(oTst)

oDoc = ThisComponent

oTst = ThisComponent.DocumentInfo

oTst = FindPropertyObject(oDoc, "DocumentInfo")

If IsNull(oTst) Then Print "Is Null"

If oTst IS ThisComponent.DocumentInfo Then Print "They are the same"

' RunSimpleObjectBrowser(oTst)

End Sub

FindPropertyObject Function

Summary:

Now I do have an idea and boy is this stuff strange. Oh yeah, and it does not work very well. In other words, consider it broken!

An object contains data objects. For example, a spreadsheet document has a property called DrawPages that I can reference directly with the command ThisComponent.DrawPages. I can use FindPropertyObject to obtain a reference to this object.

obj = FindPropertyObject(ThisComponent, "DrawPages")

I can now access the DrawPages object with the variable obj. I have found this to be buggy!

Example:

Sub StrangeThingsInStarBasic

Dim oSBObj1 As Object

Dim oSBObj2 As Object

Dim oSBObj3 As Object

Set oSBObj1 = Tools

RunSimpleObjectBrowser(oSBObj1)

'we also have a Name property!!

Print oSBObj1.Name ' @SBRTL ?? what is it?

'apropos...

Set oSBObj2 = FindObject("Gimmicks")

Print oSBObj2.Name ' @SBRTL again...

'you can change this name prop, but it does nothing

' oSBObj2.Name = "Ciao" : Print oSBObj2.Name

' oSBObj2.Name = "@SBRTL" : Print oSBObj2.Name

'need Gimmicks library Loaded, now

GlobalScope.BasicLibraries.LoadLibrary("Gimmicks")

'other old, deprecated, undocumented, almost broken stuff....

'userfields is a module in the Gimmicks library

Set oSBObj3 = FindPropertyObject(oSBObj2, "Userfields")

Print (oSBObj3 Is Gimmicks.Userfields)

'need Gimmicks library Loaded, now

GlobalScope.BasicLibraries.LoadLibrary("Gimmicks")

'the StartChangesUserfields function is in the module Userfields

'a fully qualified call!

oSBObj2.Userfields.StartChangesUserfields

End Sub

Fix Function

Summary:

Return the integer portion of a numeric expression by removing the fractional part.

See Also: CInt, Int

Syntax:

Fix(Expression)

Return value:

Double

Parameter:

Expression: Number for which to return the integer portion.

Example:

sub ExampleFix

Print Fix(3.14159) REM returns 3.

Print Fix(0) REM eturns 0.

Print Fix(-3.14159) REM returns -3.

End Sub

For...Next Statement

Summary:

Construct to repeat statements with an auto-incrementing counter.

See Also: For....Next on Page 238.

Syntax:

For counter=start To end [Step step]

statement block

[Exit For]

statement block

Next [counter]

Format Function

Summary:

Convert a number to a string formatted according to the optional format string. Multiple formats may be included in a single format string. Each individual format is separated by a “;”. The first format is used for positive numbers, the second is for negative numbers, and the third is for zero. If only one format code is present, it applies to all numbers.

Code	Description
0	If Number has a digit at the position of the 0 in the format code, the digit is displayed; otherwise a zero appears. This means that leading and trailing zeros are displayed, leading digits are not truncated, and trailing decimals are rounded.
#	This works like the 0, but leading and trailing zeros are not displayed.
.	The decimal placeholder determines the number of decimal places to the left and right of the decimal separator.
%	Multiply the number by 100 and insert the percent sign (%) where it appears in the format code.
E- E+ e- e+	If the format code contains at least one digit placeholder (0 or #) to the right of the symbol, the number is formatted in the scientific notation. The letter E or e is inserted between the number and the exponent. The number of placeholders for digits to the right of the symbol determines the number of digits in the exponent. If the exponent is negative, a minus sign is displayed directly before an exponent. If the exponent is positive, a plus sign is only displayed before exponents with E+ or e+.
,	The comma is a placeholder for the thousands separator. It separates thousands from hundreds in a number with at least four digits. The thousands delimiter is displayed if the format code contains the placeholder surrounded by digit placeholders (0 or #).
- + $ ( ) space	(+), minus (-), dollar ($), space, or brackets entered directly in the format code are displayed as the literal character.
\	The backslash displays the next character in the format code. In other words, it prevents the next character from being seen as a special character. The backslash is not displayed, unless you enter a double backslash (\\) in the format code. Characters that must be preceded by a backslash in the format code in order to be displayed as literal characters are the date- and time-formatting characters (a, c, d, h, m, n, p, q, s, t, w, y, /, :), numeric-formatting characters (#, 0, %, E, e, comma, period) and string-formatting characters (@, &, <, >, !). You may also enclose characters in double quotes.
General Number	Numbers are displayed as entered.
Currency	A dollar sign is placed in front of the number; negative numbers are enclosed in parentheses. Two decimals are displayed. (Actually, this is locale specific)
Fixed	At least one digit is displayed in front of the decimal separator. Two decimals are displayed.
Standard	Displays numbers with a locale specific thousands separator. Two decimals are displayed.
Scientific	Displays numbers in scientific notation. Two decimals are displayed.

Warning	No conversion takes place if the parameter is not a number (such as if it is a String) and an empty string is returned.
Warning	As of version 1.0.3.1, Format(123.555, “.##”) produces “.12356” which I consider a bug. Changing the format to “#.##” fixes this problem. Always use a leading “#” or “0” as appropriate. Scientific notation is just wrong (broken) Currency is placing the dollar sign to the right. Currently not able to escape special characters.

Syntax:

Format (Number [, Format As String])

Return value:

String

Parameter:

Number: Numeric expression to convert to a formatted string.

Format: Desired format. If omitted, the Format function works like the Str function.

Example:

Sub ExampleFormat

MsgBox Format(6328.2, "##,##0.00") REM = 6,328.20

MsgBox Format(123456789.5555, "##,##0.00") REM = 123,456,789.56

MsgBox Format(0.555, ".##") REM .56

MsgBox Format(123.555, "#.##") REM 123.56

MsgBox Format(0.555, "0.##") REM 0.56

MsgBox Format(0.1255555, "%#.##") REM %12.56

MsgBox Format(123.45678, "##E-####") REM 12E1

MsgBox Format(.0012345678, "0.0E-####") REM 1.2E3 (broken)

MsgBox Format(123.45678, "#.e-###") REM 1e2

MsgBox Format(.0012345678, "#.e-###") REM 1e3 (broken)

MsgBox Format(123.456789, "#.## is ###") REM 123.45 is 679 (strange)

MsgBox Format(8123.456789, "General Number")REM 8123.456789

MsgBox Format(8123.456789, "Fixed") REM 8123.46

MsgBox Format(8123.456789, "Currency") REM 8,123.46$ (broken)

MsgBox Format(8123.456789, "Standard") REM 8,123.46

MsgBox Format(8123.456789, "Scientific") REM 8.12E03

MsgBox Format(0.00123456789, "Scientific") REM 1.23E03 (broken)

End Sub

FreeFile Function

Summary:

Return the next available file number for opening a file. This ensures that the file number that you use is not already in use.

See also Open, EOF, Kill, and Close.

Syntax:

FreeFile

Return value:

Integer

Example:

See the example for Close.

FreeLibrary Function

Summary:

Release a DLL loaded by a Declare statement. The DLL will automatically reload if one of its functions is called. Only DLLs loaded during the Basic runtime may be freed.

See Also: Declare

Syntax:

FreeLibrary (LibName As String)

Parameter:

LibName: Name of the DLL.

Example:

Declare Sub MyMessageBeep Lib "user32.dll" Alias "MessageBeep" ( long )

Sub ExampleDeclare

Dim lValue As Long

lValue = 5000

MyMessageBeep( lValue )

FreeLibrary("user32.dll" )

End Sub

Function Statement

Summary:

Define a user defined function as opposed to a subroutine. Functions can return values, subroutines can not.

See Also: Sub

Syntax:

Function Name[(VarName1 [As Type][, VarName2 [As Type][,...]]]) [As Type]

statement block

[Exit Function]

statement block

End Function

Return value:

What ever type is declared

Example:

Function IsWhiteSpace(iChar As Integer) As Boolean

Select Case iChar

Case 9, 10, 13, 32, 160

IsWhiteSpace = True

Case Else

IsWhiteSpace = False

End Select

End Function

Get Statement

Summary:

Reads a record from a relative file, or a sequence of bytes from a binary file, into a variable. If the position parameter is omitted, data is read from the current position in the file. For files opened in binary mode, the position is the byte position in the file.

See Also: PUT

Syntax:

Get [#] FileNumber As Integer, [Position], Variable

Parameter:

FileNumber: Integer expression that determines the file number. I use FreeFile to get this.

Position: For files opened in Random mode, this is the record number to be read.

Variable: Variable to be read. The Object variable type may not be used here.

Example:

'?? This is broken!

Sub ExampleRandomAccess2

Dim iNumber As Integer, aFile As String

Dim sText As Variant REM Must be a variant

aFile = "c:\data1.txt"

iNumber = Freefile

Open aFile For Random As #iNumber Len=5

Seek #iNumber,1 REM Position at beginning

Put #iNumber,, "1234567890" REM Fill line with text

Put #iNumber,, "ABCDEFGHIJ"

Put #iNumber,, "abcdefghij"

REM This is how the file looks now!

REM 08 00 0A 00 31 32 33 34 35 36 37 38 39 30 08 00 ....1234567890..

REM 0A 00 41 42 43 44 45 46 47 48 49 4A 08 00 0A 00 ..ABCDEFGHIJ....

REM 61 62 63 64 65 66 67 68 69 6A 00 00 00 00 00 00 abcdefghij

REM

Seek #iNumber,1

Get #iNumber,,sText

Print "on open:" & sText

Close #iNumber

iNumber = Freefile

Open aFile For Random As #iNumber Len=5

Get #iNumber,,sText

Print "reopened: " & sText

Put #iNumber,,"ZZZZZ"

Get #iNumber,1,sText

Print "anoter get "& sText

Get #iNumber,1,sText

Put #iNumber,20,"This is the text in record 20"

Print Lof(#iNumber)

Close #iNumber

End Sub

GetAttr Function

Summary:

Return a bit pattern identifying the file type. The attributes are a superset of those used in the Dir function.

Attribute	Description
0	Normal file.
1	Read-Only file
2	Hidden files.
4	System file.
8	Volume name.
16	Directory.
32	Archive bit (file changed since last backed up)

See Also: Dir

Warning	Broken as of 1.0.3.1. Test with the version that you use.

Syntax:

GetAttr (Text As String)

Return value:

Integer

Parameter:

Text: String expression containing an unambiguous file specification. URL notation is valid.

Example:

Sub ExampleGetAttr

REM Should say " Read-Only Hidden System Archive"

REM says " Read-Only"

Print FileAttributeString(GetAttr("C:\IO.SYS"))

REM Should say " Archive" says "Normal"

Print FileAttributeString(GetAttr("C:\AUTOEXEC.BAT"))

REM "Directory"

Print FileAttributeString(GetAttr("C:\WINDOWS"))

End Sub

Function FileAttributeString(x As Integer) As String

Dim s As String

If (x = 0) Then

s = "Normal"

Else

s = ""

If (x AND 16) <> 0 Then s = "Directory"

If (x AND 1) <> 0 Then s = s & " Read-Only"

If (x AND 2) <> 0 Then s = " Hidden"

If (x AND 4) <> 0 Then s = s & " System"

If (x AND 8) <> 0 Then s = s & " Volume"

If (x AND 32) <> 0 Then s = s & " Archive"

End If

FileAttributeString = s

End Function

GetProcessServiceManager Function

Summary:

Obtain the central UNO service manager. This is required when you must instantiate a service using CreateInstance with arguments.

?? find a better example than this! Show an example that takes an argument!

Syntax:

oServiceManager = GetProcessServiceManager()

Return value:

Example:

oServiceManager = GetProcessServiceManager()

oIntrospection = oServiceManager.createInstance("com.sun.star.beans.Introspection");

this is the same as the following statement:

oIntrospection = CreateUnoService("com.sun.star.beans.Introspection")

GetSolarVersion Function

Summary:

Return the internal build number of the current OpenOffice.org version. You could write your macro to work around known bugs based on different versions. Unfortunately, the function GetSolarVersion frequently stays the same even when the versions change. Version 1.0.3.1 returns “641” and 1.1RC3 returns 645, but this is not always enough granularity. The following macro returns the actual OOo version.

Function OOOVersion() As String

'Retreives the running OOO version

'Author : Laurent Godard

'e-mail : listes.godard@laposte.net

'

Dim aSettings, aConfigProvider

Dim aParams2(0) As New com.sun.star.beans.PropertyValue

Dim sProvider$, sAccess$

sProvider = "com.sun.star.configuration.ConfigurationProvider"

sAccess = "com.sun.star.configuration.ConfigurationAccess"

aConfigProvider = createUnoService(sProvider)

aParams2(0).Name = "nodepath"

aParams2(0).Value = "/org.openoffice.Setup/Product"

aSettings = aConfigProvider.createInstanceWithArguments(sAccess, aParams2())

OOOVersion=aSettings.getbyname("ooSetupVersion")

End Function

Syntax:

s = GetSolarVersion()

Return value:

String

Example:

Sub ExampleGetSolarVersion

REM as of 1.0.3.1, this is "641"

Print GetSolarVersion()

End Sub

GetSystemTicks Function

Summary:

Return the system ticks provided by the operating system. The number of system ticks returned within a certain time frame is always dependent on the operating system.

Syntax:

GetSystemTicks()

Return value:

Long

Example:

This example will attempt to measure how many ticks per second. On Windows XP and version 1.0.3.1 of OpenOffice.org, I see 1000 ticks per second.

Sub ExampleGetSystemTicks

Dim lTick As Long, lMillisToWait As Long

Dim lSecsToWait As Long, lTicksPerSec As Long

lSecsToWait = 60

lMillisToWait = lSecsToWait * 1000

lTick = GetSystemTicks()

wait(lMillisToWait)

lTick = (GetSystemTicks() - lTick)

lTicksPerSec = lTick / lSecsToWait

MsgBox "Each second has about " & lTicksPerSec & " Ticks Per Second"

End Sub

GlobalScope Statement

Summary:

Basic macros and dialogs are organized in libraries. A library may contain modules and/or dialogs. In Basic, the library container is called “BasicLibraries” and in dialogs the container is called “DialogLibraries”. Although both library containers exist at both the application and the document level, in basic they are automatically loaded but not in the document. To call these global library containers from within a document, you must use the keyword GlobalScope.

Syntax:

GlobalScope

Example:

' calling Dialog1 in the document library Standard

oDlgDesc = DialogLibraries.Standard.Dialog1

' calling Dialog2 in the application library Library1

oDlgDesc = GlobalScope.DialogLibraries.Library1.Dialog2

GoSub Statement

Summary:

Transfer macro execution to a label within the current Sub or Function. The statements following the label are executed until the next Return statement; thereafter the program continues with the statement following the GoSub statement.

See Also: Section on flow control which explains why GoSub is generally avoided.

Tip	GoSub is a persistent remnant from old Basic dialects, retained for compatibility. GoSub is strongly discouraged because it tends to produce unreadable code. Subs or Functions are preferable.

Syntax:

Sub/Function

REM arbitrary statements here

GoSub Label

REM arbitrary statements here

GoSub Label

Exit Sub/Function

Label:

statement block

Return

End Sub/Function

Example:

Sub ExampleGoSub

Print "Before the gosub"

GoSub SillyLabel

Print "After the gosub"

Exit Sub

SillyLabel:

Print "After Silly Label"

Return

End Sub

GoTo Statement

Summary:

Transfer macro execution to a label within the current Sub or Function. The statements following the label are executed.

See Also: Section on flow control which explains why GoTo is generally avoided.

Tip	GoTo is a persistent remnant from old Basic dialects, retained for compatibility. GoTo is strongly discouraged because it tends to produce unreadable code. Subs or Functions are preferable.

Syntax:

Sub/Function

REM arbitrary statements here

GoTo Label

REM arbitrary statements here

GoTo Label

Exit Sub/Function

Label:

statement block

End Sub/Function

Example:

Sub ExampleGoTo

Print "Before the goto"

GoTo SillyLabel

Print "After the goto" REM Never executed

Exit Sub REM Never executed

SillyLabel:

Print "After Silly Label"

End Sub

Green Function

Summary:

Colors are represented by a long integer. Return the green component of the specified color code. See also RGB, Red, and Blue.

Syntax:

Green(Color As Long)

Return value:

Integer in the range of 0 to 255.

Parameter:

Color value: Long integer expression representing a color.

Example:

Sub ExampleColor

Dim lColor As Long

lColor = RGB(255,10,128)

MsgBox "The color " & lColor & " consists of:" & Chr(13) &_

"Red = " & Red(lColor) & Chr(13)&_

"Green= " & Green(lColor) & Chr(13)&_

"Blue= " & Blue(lColor) & Chr(13) , 64,"Colors"

End Sub

HasUnoInterfaces Function

Summary:

Test if a Basic UNO object supports specified UNO interfaces. Returns true only if all of the specified UNO interfaces are supported.

Syntax:

HasUnoInterfaces( oTest, UNO-Interface-Name 1 [, UNO-Interface-Name 2, ...])

Return value:

Boolean

Parameter:

oTest : The Basic UNO object to test.

UNO-Interface-Name: list of UNO interface names.

Example:

Sub CloseOpenDocument

If HasUnoInterfaces(oDoc, "com.sun.star.util.XCloseable") Then

oDoc.close(true)

Else

oDoc.dispose

End If

End Sub

Hex Function

Summary:

Returns a string that represents the hexadecimal value of a number. If the parameter is not a number, it is converted into a number if possible.

Syntax:

Hex(Number)

Return value:

String

Parameter:

Number: Numeric expression to be converted to a hexadecimal number. May be a string.

Example:

Sub ExampleHex

Dim i1%, i2%, iNum%, s$, sFormat$, sTemp$

iNum = 0

s = ""

For i1=0 To 15

For i2=0 To 15

s = s & " " & PrependChar(Hex(iNum), "0", 2)

iNum = iNum + 1

Next

s = s & Chr(13)

Next

MsgBox s, 64, "Hex Table"

Print Hex("64")

End Sub

Function PrependChar(s$, sPrependString$, iTotLen%) As String

If Len(s) < iTotLen Then

PrependChar = String(iTotLen - Len(s), sPrependString) & s

Else

PrependChar = s

End If

End Function

Hour Function

Summary:

Return the hour from a time value generated by TimeSerial or TimeValue.

Syntax:

Hour(Number)

Return value:

Integer

Parameter:

Number: Numeric expression that contains a serial time value.

Example:

Sub ExampleHour

Print "The current hour is " & Hour( Now )

Print Hour(TimeSerial(14,08,12))

Print Hour(TimeValue("14:08:12"))

End Sub

If Statement

Summary:

Defines one or more statement blocks to be executed if a given condition is True. Although you can use GoTo or GoSub to jump out of an If block, you can not jump into an If block.

Syntax:

If condition=true Then

Statementblock

[ElseIf condition=true Then]

Statementblock

[Else]

Statementblock

End If

Syntax:

If condition=True Then Statement

If condition=False Then Statement

Example:

Sub ExampleIf

Dim i%

i% = 4

If i < 5 Then

Print "i is less than 4"

If i = 4 Then Print "i is 4"

If i < 3 Then

Print "i is less than 3"

End If

ElseIf i = 5 Then

Print "i is 5"

Else

Print "i is greater than 5"

End If

End Sub

IIF Statement

Summary:

Return one of two possible function results, depending on the logical value of the evaluated expression. Although I love this command, I have occasionally seen behavior that left me uneasy as to its reliability as of 1.0.3.1.

Syntax:

IIf (Expression, ExpressionTrue, ExpressionFalse)

Return value:

ExpressionTrue or ExpressionFalse

Parameter:

Expression: Conditional expression to be evaluated.

ExpressionTrue: Returned if the Expression above is true.

ExpressionFalse : Returned if the Expression above is false.

Example:

Sub IIfExample

Print IIf(3>4,"Yes", "No") REM No

Print IIf(4>2,"Yes", "No") REM Yes

End Sub

Imp Operator

Summary:

Perform a logical implication on two expressions. In the study of logic, it is said that x implies y if y is true whenever x is true. If x is false, however, the value of y is irrelevant and the expression is considered true. Consider the statement: If you are large (x), you will not be mugged (y). If you are large and you are mugged (x=True, y=False) then this statement is false. If you are large and not mugged (x=True, y=True) then this statement is true. If you are not large (x=False) then nothing can invalidate this statement.

x	y	x IMP y
TRUE	TRUE	TRUE
TRUE	FALSE	FALSE
FALSE	TRUE	TRUE
FALSE	FALSE	TRUE
1	1	1
1	0	0
0	1	1
0	0	1

Warning	As of 1.0.3.1, this is incorrect for (0 Imp 1 = 0)
Warning	Imp does not seem to work with constants vC = -1 : vD = 0 Print -1 Imp 0 REM -1 (incorrect) Print vC Imp vD REM 0 (correcect)
Tip	Use (Not x Or y) rather than (x Imp y) because it is logically equivalent and returns the correct values. (2 Imp 1) should return -3!

Syntax:

Result = Expression1 Imp Expression2

Parameter:

Expression1, Expression2 : Numeric or boolean expressions.

Example:

Sub ExampleImp

Dim bFalse As Boolean, bTrue As Boolean

Dim i1%, i2%

bFalse = False : bTrue = True

Print bTrue Imp bTrue REM -1

Print bTrue Imp bFalse REM 0

Print bFalse Imp bTrue REM 0

Print bFalse Imp bFalse REM -1

i1 = 1 : i2 = 0

Print i1 Imp i1 REM -1

Print i1 Imp i2 REM -2

Print i2 Imp i1 REM -2

Print i2 Imp i2 REM -1

Print 1 Imp 0 REM -1

End Sub

Input Statement

Summary:

The Input statement is used to sequentially read numeric or string records from an open file and assign the data to one or more variables. The carriage return (Asc=13), line feed (Asc=10), and comma act as delimiters. When a numeric is read, a space is also used as a delimiter. Reading a non-numeric value into a numeric variable sets the value of the variable to zero.

It is not possible to read commas or quotation marks (") using the Input# statement. If you want to do this, then use the Line Input statement.

See Also: Open, Line Input#, Close, Eof, Get

Syntax:

Input #FileNumber var1[, var2[, var3[,...]]]

Parameter:

FileNumber: Number of the file from which data is to be read.

var: Numeric or String variables into which the read data will be placed.

Example:

??

InputBox Function

Summary:

Prompt the user for input in a dialog box. On cancel, a zero-length string is returned. If no position is provided, then the dialog is centered on the screen.

Syntax:

InputBox (Msg [, Title[, Default[, x_pos, y_pos As Integer]]]])

Return value:

String

Parameter:

Msg: Message string displayed in the dialog box.

Title: Shown in the title bar of the dialog box.

Default: Default input string displayed in the text box.

x_pos: Absolute horizontal position in twips. This is an integer.

y_pos: Absolute vertical position in twips. This is an integer.

Example:

Sub ExampleInputBox

Dim s$

s = InputBox ("Prompt:","Title", "default")

MsgBox ( s , 64, "Confirmation of phrase")

End Sub

InStr Function

Summary:

Returns the position of a string within another string.

The Instr function returns the position at which the match was found. If the string was not found, the function returns 0.

Warning	As of 1.1.2, the return type is an integer but the return value may be as large as a string which is 64K. A negative number is returned if the value is too large. Sub BugInStr Dim b$, i& b$ = String(40000, "a") & "|" REM character 40,001 is an "|" i = instr(b, "|") REM -25535 MsgBox cstr(i) & " or " & (65536 + i) REM -25535 or 40001 End Sub

Syntax:

InStr([Start As Integer,] Text1 As String, Text2 As String[, Compare])

Return value:

Integer

Parameter:

Start: Optional start position within the string. Defaults to 1, the first character.

Text1: String expression in which to search.

Text2: String expression for which to search.

Compare: If 1, then a case-insensitive compare, the default value 0 is a binary comparison.

Example:

Sub ExampleInStr

Dim s$

s = "SbxInteger getTruck(SbxLong)"

RemoveFromString(s, "Sbx")

Print s

End Sub

REM This deletes all occurrences of bad$ from s$

REM This modifies the string s$

Sub RemoveFromString(s$, bad$)

Dim i%

i = InStr(s, bad)

Do While i > 0

Mid(s, i, Len(bad), "")

i = InStr(i, s, bad)

Loop

End Sub

Warning	You can not use the “Compare” parameter unless you also use the “Start” parameter.

Int Function

Summary:

Returns the largest integer that is not greater than the parameter. This means that it rounds the number toward negative infinity. Negative numbers, therefore, become greater in magnitude and positive numbers become smaller in magnitude.

See Also: CInt, Fix

Syntax:

Int (Number)

Return value:

Double

Parameter:

Number: Any valid numeric expression.

Example:

Sub ExampleINT

Print " " & Int(3.14159) & " " & Fix(3.14) REM 3 3

Print " " & Int(0) & " " & Fix(0) REM 0 0

Print " " & Int(-3.14159) & " " & Fix(-3.1415) REM -4 -3

Print " " & Int(2.8) & " " & Fix(2.8) REM 2 2

End Sub

Warning	-3.4 rounds to -4. Use Fix if you want to drop the fractional portion.

IsArray Function

Summary:

Tests if a variable is an array.

Syntax:

IsArray(Var)

Return value:

boolean

Parameter:

Var: Any variable to be tested whether it was declared as an array.

Example:

Sub ExampleIsArray

Dim sDatf(10) as String, i

Print IsArray(sDatf()) 'True

Print IsArray(i()) 'False

End Sub

IsDate Function

Summary:

Tests whether a numeric or string can be converted to a Date.

Syntax:

IsDate(Expression)

Return value:

boolean

Parameter:

Expression: Any numeric or string expression to be tested.

Example:

Sub ExampleIsDate

Print IsDate("12.12.1997") 'True

Print IsDate("12121997") 'False

End Sub

IsEmpty Function

Summary:

Tests if a Variant variable contains the Empty value, indicating that the variable has not been initialized.

See also: “Object, Variant, Empty, and Null” on page 230.

Syntax:

IsEmpty(Var)

Return value:

boolean

Parameter:

Var: Any variable to be tested.

Example:

Sub ExampleIsEmpty

Dim v1 as Variant, v2 As Variant, v3 As Variant

v2 = Null : v3 = "hello"

Print IsEmpty(v1) ' True

Print IsEmpty(v2) ' False

Print IsEmpty(v3) ' False

v2 = Empty ' ?? Broken as of version 1.0.3.1 and 1.1.1.

Print IsEmpty(v2) ' Should say true

End Sub

IsMissing Function

Summary:

Tests if a subroutine or function was called with, or without, an optional parameter. The parameter must be declared with the “Optional” keyword for this to work. As of version 1.0.3.1, there were some minor bugs as mentioned in the section on optional parameters on page 235.

Syntax:

IsMissing(var)

Return value:

boolean

Parameter:

var: Variable to check

Example:

Function FindCreateNumberFormatStyle (sFormat As String, Optional doc, Optional locale)

Dim oDocument As Object

Dim aLocale As New com.sun.star.lang.Locale

Dim oFormats As Object

'If it was not sent, then use ThisComponent

oDocument = IIf(IsMissing(doc), ThisComponent, doc)

oFormats = oDocument.getNumberFormats()

....

End Function

IsNull Function

Summary:

Tests whether a Variant or Object contains the special Null value, indicating that the variable contains no data. An uninitialized Object is NULL, an uninitialized Variant is Empty but it may be set to contain the NULL value.

See also: IsEmpty, include Macro GetSomeObjInfo

Syntax:

IsNull(Var)

Return value:

boolean

Parameter:

var: Variable to check

Example:

Sub ExampleIsNull

Dim v1 as Variant, v2 As Variant, v3 As Variant, o As Object

v2 = Null : v3 = "hello"

Print IsNull(v1) ' False

Print IsNull(v2) ' True

Print IsNull(v3) ' False

v3 = Null

Print IsNull(v3) ' True

Print IsNull(o) ' True

End Sub

IsNumeric Function

Summary:

Tests if the given expression is a number or may be converted into one.

Syntax:

IsNumeric(Var)

Return value:

boolean

Parameter:

Var: Any expression to be tested.

Example:

Sub ExampleIsNumeric

Dim v1, v2, v3

v1 = "abc" : v2 = "123" : v3 = 4

Print IsNumeric(v1) ' False

Print IsNumeric(v2) ' True

Print IsNumeric(v3) ' True

Print IsNumeric("123x")' False

End Sub

IsObject Function

Summary:

According to the on-line documentation, this tests whether the given object variable is an OLE object. I looked at the source code and ran a test, and this also returns true for a regular object. IsObject also returns true if the argument is a variant that contains an object.

See also: include Macro GetSomeObjInfo

Syntax:

IsObject(ObjectVar)

Return value:

boolean

Parameter:

ObjectVar: Any variable to be tested.

Example:

Sub ExampleIsObject

Dim o As Object, s AS String

Print IsObject(o) ' True

Print IsObject(s) ' False

End Sub

IsUnoStruct Function

Summary:

Returns true, if the given object is a UNO struct. The on-line help incorrectly states that the parameter is a name rather than an object.

See also: include Macro GetSomeObjInfo

Syntax:

IsUnoStruct(var)

Return value:

boolean

Parameter:

var: object to test

Example:

Sub ExampleIsUnoStruct

Dim o As Object, s AS String

Dim aProperty As New com.sun.star.beans.Property

Print IsUnoStruct(o) ' False

Print IsUnoStruct("com.sun.star.beans.Property") ' False

Print IsUnoStruct(aProperty) ' True

End Sub

Kill Function

Summary:

Deletes a file from disk. Any file notation may be used but wild cards are not supported.

Syntax:

Kill(file_name)

Return value:

None

Parameter:

file_name : Name of the file to kill

Example:

Sub ExampleKill

Kill "C:\datafile.dat"

End Sub

LBound Function

Summary:

Returns the lower bound of an array. An array index does not have to start at 0.

Syntax:

LBound(ArrayName [, Dimension])

Return value:

Integer

Parameter:

ArrayName: Name of the array for which to return the lower limit of the array dimension.

[Dimension] : Integer that specifies which dimension is desired. If no value is specified, the first dimension is assumed.

Example:

Sub ExampleUboundLbound

Dim a1(10 to 20) As String, a2 (10 to 20,5 To 70) As String

Print "(" & LBound(a1()) & ", " & UBound(a1()) & ")" ' (10, 20)

Print "(" & LBound(a2()) & ", " & UBound(a2()) & ")" ' (10, 20)

Print "(" & LBound(a2(),1) & ", " & UBound(a2(),1) & ")" ' (10, 20)

Print "(" & LBound(a2(),2) & ", " & UBound(a2(),2) & ")" ' (5, 70)

End Sub

LCase Function

Summary:

Return a lower case copy of the string. This does not modify the string.

Syntax:

LCase (String)

Return value:

String

Parameter:

String: string to be returned as lower case.

Example:

Sub ExampleLCase

Dim s$

s = "Las Vegas"

Print LCase(s) REM Returns "las vegas"

Print UCase(s) REM Returns "LAS VEGAS"

end Sub

Left Function

Summary:

Returns the leftmost n characters of a string.

Warning	As of 1.1RC2, the parameter to Left is an integer but the string may be 64K long.

Syntax:

Left(String, Integer)

Return value:

String

Parameter:

String: Any string expression

Integer: Number of characters to return. If 0, a zero-length string is returned.

Example:

Print Left("123456789", 2) 'Prints 12

Len Function

Summary:

Returns the number of characters in a string, or the number of bytes required to store a variable.

Syntax:

Len(Text As String)

Return value:

Long

Parameter:

Text: Any string expression or a variable of another type.

Example:

Sub ExampleLen

Dim s$, i%

s = "123456"

i = 7

Print Len(s) '6

Print Len(i) '1

Print Len(1134) '4

Print Len(1.0/3)'17

End Sub

Let Function

Summary:

Optional keyword indicating that a value is to be assigned to a variable. This is rarely used.

Syntax:

[Let] VarName=Expression

Return value:

None

Parameter:

VarName: Variable to which a value will be assigned.

Example:

Sub ExampleLet

Dim s$

Let s = "Las Vegas"

End Sub

Line Input Statement

Summary:

Reads strings from a sequential file to a variable. First, you must open the file with the Open statement. String variables are read line-by-line up to the first carriage return (Asc=13) or linefeed (Asc=10). Line end marks are not included in the resulting string.

Syntax:

Line Input #FileNumber As Integer, Var As String

Return value:

None

Parameter:

FileNumber: Number of the open file from which data is to be read.

var: The name of the variable used to store the result.

Example:

Loc Function

Summary:

The Loc function returns the current position in an open file. If the Loc function is used for an open random access file, it returns the number of the last read or written record. For a sequential file, the Loc function returns the position in a file divided by 128. For binary files, the position of the last read or written byte is returned. ?? Verify this!

Syntax:

Loc(FileNumber)

Return value:

Long

Parameter:

FileNumber: Numeric expression containing the file number of an open file.

Example:

??

Lof Function

Summary:

Lof returns the size of an open file in bytes. To obtain the length of a file that is not open, use the FileLen function.

Syntax:

Lof(FileNumber)

Return value:

Long

Parameter:

FileNumber: Numeric expression containing the file number of an open file.

Example:

?? Verify this

Sub ExampleRandomAccess

Dim iNumber As Integer

Dim sText As Variant REM must be a Variant

Dim aFile As String

aFile = "c:\data.txt"

iNumber = Freefile

Open aFile For Random As #iNumber Len=32

Seek #iNumber,1 REM Position at start

Put #iNumber,, "This is the first line of text" REM Fill with text

Put #iNumber,, "This is the second line of text"

Put #iNumber,, "This is the third line of text"

Seek #iNumber,2

Get #iNumber,,sText

Print sText

Close #iNumber

iNumber = Freefile

Open aFile For Random As #iNumber Len=32

Get #iNumber,2,sText

Put #iNumber,,"This is a new line of text"

Get #iNumber,1,sText

Get #iNumber,2,sText

Put #iNumber,20,"This is the text in record 20"

Print Lof(#iNumber)

Close #iNumber

End Sub

Log Function

Summary:

Returns the natural logarithm of a number. The natural logarithm is the logarithm to the base e. Base e is a constant with the approximate value 2.718282... You can calculate logarithms to any base (n) for any number (x) by dividing the natural logarithm of x by the natural logarithm of n, as follows: Log_n(x) = Log(x) / Log(n)

Syntax:

Log(Number)

Return value:

Double

Parameter:

Number: Numeric expression for which to calculate the natural logarithm.

Example:

Sub ExampleLogExp

Dim a as Double

Dim const b1=12.345e12

Dim const b2=1.345e34

a=Exp( Log(b1)+Log(b2) )

MsgBox "" & a & chr(13) & (b1*b2) ,0,"Multiplication by logarithm function"

End Sub

Loop Statement

Summary:

The Loop statement is used to repeat statements while a condition is true, or until a condition becomes true. See the treatment on do loops on page 239.

Syntax:

Do [{While | Until} condition = True]

statement block

[Exit Do]

statement block

Loop

Syntax:

Do

statement block

[Exit Do]

statement block

Loop [{While | Until} condition = True]

Example:

Sub ExampleDoLoop

Dim sFile As String, sPath As String

sPath = "c:\" : sFile = Dir$( sPath ,22)

If sFile <> "" Then

Do

MsgBox sFile

sFile = Dir$

Loop Until sFile = ""

End If

End Sub

LSet Statement

Summary:

LSet allows you to left justify a string within the space taken used by another. Any leftover positions are filled with spaces. If any text in the new string can not fit into the old string, it is truncated. This is broken in versions prior to 1.1.x.

LSet also allows you to overlay data from one user-defined type with data from another. This takes all the bytes from one data structure and overlays them on top of another, ignoring the underlying structure. I have not tried this with a user defined type in version 1.1.1.

Syntax:

LSet Var As String = Text

LSet Var1 = Var2

Parameter:

Var: Any String variable, in which the string to be aligned to the left.

Text: String to be aligned to the left of the string variable.

Var1: Name of the user-defined type variable being copied to.

Var2: Name of the user-defined type variable being copied from.

Example:

Sub ExampleLSet

Dim sVar As String, sExpr As String

sVar = String(40,"*")

sExpr = "SBX"

REM Left-align "SBX" within the 40-character reference string

LSet sVar = sExpr

Print ">"; sVar; "<" REM ">SBX <"

sVar = String(5,"*")

sExpr = "123456789"

LSet sVar = sExpr

Print ">"; sVar; "<" REM ">12345<"

End Sub

LTrim Function

Summary:

Removes all leading spaces of a string expression.

Syntax:

LTrim(Text)

Return value:

String

Parameter:

Text: Any string expression.

Example:

Sub ExampleSpaces

Dim sText2 As String,sText As String,sOut As String

sText2 = " <*Las Vegas*> "

sOut = "'"+sText2 +"'"+ Chr(13)

sText = Ltrim(sText2) REM sText = <*Las Vegas*> "

sOut = sOut + "'"+sText +"'" + Chr(13)

sText = Rtrim(sText2) REM sText = " <*Las Vegas*> "

sOut = sOut +"'"+ sText +"'" + Chr(13)

sText = Trim(sText2) REM sText = " <*Las Vegas*> "

sOut = sOut +"'"+ sText +"'"

MsgBox sOut

End Sub

Private Keyword

Summary:

The Private keyword is used to declare a variable outside of a subroutine as private. If a variable is declared using the Dim keyword, it is considered private. See the description on Dim for syntax descriptions.

See also: Dim, Public

Syntax:

Private Name_1 [(start To end)] [As VarType][, Name_2 [(start To end)] [As VarType][,...]]

Example:

Private iPriv As Integer

Sub ExamplePublic

iPriv = 1

Call CalledSub

End Sub

Sub CalledSub

Print iPriv REM 1

End Sub

Public Keyword

Summary:

The Public keyword is used to declare a variable outside of a subroutine as Public to all modules. If a variable is declared using the Dim keyword, it is considered private. See the description on Dim for syntax descriptions.

See also: Dim, Private

Syntax:

Public Name_1 [(start To end)] [As VarType][, Name_2 [(start To end)] [As VarType][,...]]

Example:

Public iPub As Integer

Sub ExamplePublic

iPub = 1

Call CalledSub

End Sub

Sub CalledSub

Print iPub REM 1

End Sub

Red Function

Summary:

Colors are represented by a long integer. Return the red component of the specified color code. See also RGB, Blue, and Green.

Syntax:

Red(Color As Long)

Return value:

Integer in the range of 0 to 255.

Parameter:

Color value: Long integer expression representing a color.

Example:

Sub ExampleColor

Dim lColor As Long

lColor = RGB(255,10,128)

MsgBox "The color " & lColor & " consists of:" & Chr(13) &_

"Red = " & Red(lColor) & Chr(13)&_

"Green= " & Green(lColor) & Chr(13)&_

"Blue= " & Blue(lColor) & Chr(13) , 64,"Colors"

End Sub

RSet Statement

Summary:

RSet allows you to right justify a string within the space taken used by another. Any leftover positions are filled with spaces. If any text in the new string can not fit into the old string, it is truncated. Although RSet was broken in OOo version 1.0.3.1, it works in OOo version 1.1.1.

Syntax:

RSet Var As String = Text

Parameter:

Var: Any String variable, in which the string to be aligned to the left.

Text: String to be aligned to the left of the string variable.

Example:

Sub ExampleRSet

Dim sVar As String, sExpr As String

sVar = String(40,"*")

sExpr = "SBX"

RSet sVar = sExpr

Print ">"; sVar; "<" REM "> SBX<"

sVar = String(5,"*")

sExpr = "123457896"

RSet sVar = sExpr

Print ">"; sVar; "<" REM ">12345<"

End Sub

Shell Function

Summary:

Start an external application. The window style of the started application may be optionally included with the following values:

Style	Description
0	Focus is on the hidden program window.
1	Focus is on the program window in standard size.
2	Focus is on the minimized program window.
3	Focus is on the maximized program window.
4	Standard size program window, without focus.
6	Minimized program window, but focus remains on the active window.
10	Full-Screen display.

The program is assumed to start and continue running in the background unless the last parameter (bsync) is set to True. This means that control is returned immediately from the Shell command.

The return type is not specified in the on-line help. Experimentally, I have determined this type to be a LONG. The return value has always been zero when I have bothered to check it. If the program does not exist, then an error is generated and the macro halts.

Syntax:

Shell (Pathname As String[, Windowstyle As Integer][, Param As String][, bSync])

Return value:

Long

Parameter:

Pathname: Complete path and program name of the program to start.

Windowstyle: Specifies the style of the window in which the program is executed.

Param: Any string expression that specifies the command line to be passed.

bSync: If False (the default), an immediate return occurs. If True, then the Shell statement does not return until after the program is finished running.

Example:

Sub ExampleShell

Dim vRC As Variant

REM A window type of 2 displays the window normally on top

REM

vRC = Shell("C:\andy\TSEProWin\g32.exe", 2, "c:\Macro.txt")

Print "I just returned and the returnec code is " & vRC

REM These two have spaces in their names

Shell("file:///C|/Andy/My%20Documents/oo/tmp/h.bat",2)

Shell("C:\Andy\My%20Documents\oo\tmp\h.bat",2)

End Sub

Antal Attila <atech@nolimits.ro> provided the following example of the use of the bsync argument.

Sub Main()

' first you need to create on your disk a file with the following

content:

' on Windows (with name C:\tmp\Test.bat):

' echo %1

' pause

' on Linux (with name /home/guest/Test.sh):

' echo $1

' sleep 100000

' ------------ Sync example ------------------

' calling my shell runner method with bSync=TRUE

' the basic execution will hanging up while the terminal

' ( or msdos prompt) will be closed (any key or Ctrl+C)

' on Windows

shellRunner("file://C:/tmp/", "Test", "Helo World", TRUE)

' or on Linux

shellRunner("file:///home/guest/", "Test", "Helo World", TRUE)

' signaling the end of execution

Print "The End"

' ------------ Async example ------------------

' calling my shell runner method with bSync=FALSE

' the basic execution will be continued

' on Windows

shellRunner("file://C:/tmp/", "Test", "Helo World", FALSE)

' or on Linux

shellRunner("file:///home/guest/", "Test", "Helo World", FALSE)

' signaling the end of execution

Print "The End"

End Sub

Sub shellRunner(dirPath$, script$, prms$, sync as Boolean)

Dim filePath$, ef$, ed$, isWindows as Boolean

' loking for OS type

If instr(mid(dirPath,8),":/")>0 or instr(dirPath,8),"\")>0 Then

isWindows=TRUE

Else

isWindows=FALSE

End If

' converting the url to file path

filePath = convertFromURL(dirPath)

' creating the execution string

If isWindows Then

ef = "command.com /C "+filePath+script+".bat"

Else

ef = "xvt -e sh "+filePath+script+".sh"

End If

' running the shell command

Shell(ef, 1, prms, sync)

End Sub

UBound Function

Summary:

Returns the upper bound of an array.

Syntax:

UBound(ArrayName [, Dimension])

Return value:

Integer

Parameter:

ArrayName: Name of the array for which to return the lower upper of the array dimension.

[Dimension] : Integer that specifies which dimension is desired. If no value is specified, the first dimension is assumed.

Example:

Sub ExampleUboundLbound

Dim a1(10 to 20) As String, a2 (10 to 20,5 To 70) As String

Print "(" & LBound(a1()) & ", " & UBound(a1()) & ")" ' (10, 20)

Print "(" & LBound(a2()) & ", " & UBound(a2()) & ")" ' (10, 20)

Print "(" & LBound(a2(),1) & ", " & UBound(a2(),1) & ")" ' (10, 20)

Print "(" & LBound(a2(),2) & ", " & UBound(a2(),2) & ")" ' (5, 70)

End Sub

UCase Function

Summary:

Return an upper case copy of the string. This does not modify the string.

Syntax:

UCase (String)

Return value:

String

Parameter:

String: string to be returned as upper case.

Example:

Sub ExampleUCase

Dim s$

s = "Las Vegas"

Print LCase(s) REM Returns "las vegas"

Print UCase(s) REM Returns "LAS VEGAS"

end Sub

URL Notation And Filenames

URL Notation

On a windows computer, “c:\autoexec.bat” is a typical method to reference a file. This may also be referenced in URL notation as “file:///c|/autoexec.bat”. A general idea when performing such conversions is to start the URL with “file:///”, change “:” to “|”, and replace “\” with “/”. If you want to insert the computer name or IP address, insert it between the second and third “/” characters as in “file://localhost/c|/autoexec.bat/”.

Paths With Spaces And Other Special Characters

Spaces and special characters can be embedded into URLs are standard file notation using the standard URL escape sequence. Take the ASCII value you intend to embed, convert it to hex, precede it with a “%”, and then place it where you want the character. Consider embedding a space in a path. “c:\My%20Documents\info.sxw” and “file///c|/My%20Documents/info.sxw”.

Anchoring To The Home Directory On Unix

Thanks to Andrew McMillan (andrew@catalyst.net.nz), who mentions that on a Unix/Linux system a person may anchor a pathname to a home directory as follows:

file://~/document.sxw - document.sxw in my home directory.

file://~person/document.sxw - document.sxw in "person" home directory.

Other languages

C#

In C#, you must use COM objects to access OOo objects. Everything is returned as an object, including integers and such. The following simple C# example should demonstrate how to call a variety of different methods with different return values. This is not meant to be a complete example. If you have better and different examples, let me know.

Listing 19.1: Simple C# example to access bookmarks.

using System;

using System.Reflection;

namespace ootest

{

class Class1

{

// obj - Invoke a method on this object.

// method - name of the method to invoke.

// par - Array of objct arguments

static object Invoke(object obj,string method, params object[] par)

{

return obj.GetType().InvokeMember(method,BindingFlags.InvokeMethod,null,obj,par);

}

static void PrintImpName(object obj)

{

object x = Invoke(obj, "getImplementationName", new object[0]);

System.Console.WriteLine(x.ToString());

}

/// <summary>

/// The main entry point for the application.

/// </summary>

[STAThread]

public static void Main(string[] args)

{

// Get a copy of the service manager.

object usm=Activator.CreateInstance(Type.GetTypeFromProgID("com.sun.star.ServiceManager"));

// Create a copy of the desktop. Remember that there is ONLY one.

object desk=Invoke(usm,"createInstance","com.sun.star.frame.Desktop");

PrintImpName(desk);

// The typical example loads a new Calc document

//object calcDoc=Invoke(desk,"loadComponentFromURL","private:factory/scalc","_blank",0,new object[0]);

// How about getting the current component? this takes no arguments

object oDoc = Invoke(desk,"getCurrentComponent", new object[0]);

PrintImpName(oDoc);

//System.Threading.Thread.Sleep(1000);

object x = Invoke(oDoc, "supportsService", "com.sun.star.text.TextDocument");

if (x is bool && (bool) x)

{

System.Console.WriteLine("The current component is a text document");

}

else

{

System.Console.WriteLine("The current component is NOT a text document");

System.Threading.Thread.Sleep(10000);

return;

}

object oBookmarks = Invoke(oDoc, "getBookmarks", new object[0]);

x = Invoke(oBookmarks, "getCount", new object[0]);

int nCount = (int) x;

for (int n = 0; n < nCount; ++n)

{

object oMark = Invoke(oBookmarks, "getByIndex", n);

x = Invoke(oMark, "getName", new object[0]);

System.Console.WriteLine((string) x);

}

System.Threading.Thread.Sleep(5000);

}

}

}

Visual Basic Programmers

I am not really a Visual Basic programmer and I have not had much experience with macros using Visual Basic. My book contains numerous notes on differences at the language level so I will not repeat that information here – if you want to see that, buy the book. After adding so much information into my book, I did not have a lot of room to add this sort of information, so I opted to add it here as I learned it.

ActiveWorkbook

To obtain the “active workbook” from OOo Basic, use the variable ThisComponent. If you are not using OOo Basic, then you must obtain the current component from the desktop object. Unfortunately, the Basic IDE and the OOo help window is also a component of the desktop, so you need to verify that the component supports the XModel interface. Some of the examples in this document use code such as StarDesktop.getCurrentComponent() or StarDesktop.CurrentComponent to obtain the current document. This type of code usually fails when it is run from the IDE because the IDE is the current component, but the last document that was current is referenced by the variable ThisComponent.

OpenOffice.org documents support a model, that contains the data, a view to display the data, and a controller that interacts with the user. It is the controller that knows what the user is doing so in general, if you want to know the current state of things, you should obtain the document's current controller and ask it. It is the current controller, for example, that knows about the currently selected text, the active sheet and the active cell.

ActiveSheet and ActiveCell

To find the active sheet, you need to call getActiveSheet() on an object that supports the SpreadSheetView service. Well, really, it must support the XSpreadsheetView interface, but the SpreadsheetView service supports the interface:
http://api.openoffice.org/docs/common/ref/com/sun/star/sheet/SpreadsheetView.html
Obtain the obtain that spreadsheet view by calling ThisComponent.getCurrentController(). The current controller is what interacts with the user and so it is what knows what is currently selected. The current controller for a Writer document will not support the SpreadSheetView service.

The problem with the current cell is that you may not have a current cell, at least not one that is obviously available. Typically, you obtain the current selection, which may be a cell, a range of cells, or multiple disjoint selections. Section 6.5 deals with selected text in a Calc document.

If you have multiple things selected and you need to know which cell contains the cursor, then you have to perform a little trickery because this is not directly available. It is possible to simply move the cell one position left and then back again, but this can fail and you lose the current selection. A more elegant solution that works was created by Paolo Mantovani and demonstrated in the RetrieveTheActiveCell method that is shown in the section Get the active cell and ignore the rest on page 103.

Index

^	249, 262

-	249, 261

*	249, 261

/	249, 263

&	249

+	249, 262

<	234, 249

<=	234, 249

<>	234, 249

=	233, 249

>	234, 249

>=	234, 249

Abs	264

And	234, 249, 263

ApplicationScriptLibraryContainer	80p.

Array	231pp.

Asc	265, 273

ATN	266

AVERAGE	107

Beep	266

Blue	267

Boolean	225

BottomLine	109

ByVal	236, 267

Call	268

case	243

CBool	268

Cbyte	269

CDate	269

CDateFromIso	269p.

CDateToIso	270

CDbl	271

Cell

CellAddress	104, 208p.

CellAddressConversion	103p.

CellBackColor	102

getFormula	101

getSpreadSheet	104, 208p.

getString	101

getValue	101

IsCellBackgroundTransparent	102

NumberFormat	102, 107

setFormula	102, 107

setString	102, 107

setValue	102

CellAddress

Column	104, 208p.

Row	104, 208p.

CharacterProperties

CharFontName	152

CharHeight	152, 172

CharLocale	66, 153

CharPosture	152

FontSlant	152

CharUnderline	152p.

CharWeight	152p., 158, 161

FontWeight	152p., 158, 161

FontSlant

DONTKNOW	152

ITALIC	152

NONE	152

OBLIQUE	152

REVERSE_ITALIC	152

REVERSE_OBLIQUE	152

FontUnderline

BOLD	153

BOLDDASH	153

BOLDDASHDOT	153

BOLDDASHDOTDOT	153

BOLDDOTTED	153

BOLDLONGDASH	153

BOLDWAVE	153

DASH	153

DASHDOT	153

DASHDOTDOT	153

DONTKNOW	153

DOTTED	153

DOUBLE	153

DOUBLEWAVE	153

LONGDASH	153

NONE	153

SINGLE	153

SMALLWAVE	153

WAVE	153

FontWeight

BLACK	153

BOLD	153

DONTKNOW	153

LIGHT	153

NORMAL	153

SEMIBOLD	153

SEMILIGHT	153

THIN	153

ULTRABOLD	153

ULTRALIGHT	153

ChDir	271

ChDrive	272

Choose	272

Chr	265, 273

Christian Anderson	235

CInt	273

clipboard	63

CLong	274

Close	34p., 41, 49, 274, 292, 305

COM	1

Component

CurrentController	108

CurrentSelection	107

DatabaseRanges	108

getCurrentController	110

getText	7

removeByName	108

computed goto	243

ConfigurationAccess	33p.

ConfigurationProvider	31, 33p.

ConfigurationUpdateAccess	31

Const	275

Control

button	185

check box	186

combo box	186

Controls	184

group box	186

label	185

list box	185

progress bar	186

radio button	186

text box	185

Controller

ActiveSheet	108

getViewCursor()	152p.

select	110

StatusIndicator	29

ConvertFromURL	276

ConvertToURL	276

Cos	277

createInstanceWithArguments	33p.

CreateUnoDialog	183, 277

CreateUnoService	7p., 278

CreateUnoStruct	279

CSng	279

CStr	280

CurDir	280

Currency	225, 229

CurrentController	29

Cursor

compareRegionEnds	129, 132pp., 138pp., 142, 145p., 159p., 162

compareRegionStarts	129, 141p., 148, 157, 162

CreateTextCursor	40p., 57, 59, 66, 113, 130pp., 147, 151, 156, 163p.

createTextCursorByRange	36, 51, 128pp., 142, 144, 147pp., 152pp., 157, 214

getStart()	152p.

goLeft	124, 130, 135p., 145p., 148

goRight	66, 124, 129, 132pp., 138p., 144pp., 159p., 162pp.

gotoEnd	40, 57, 125, 130p., 147, 156

gotoEndOfParagraph	152, 155p., 163pp.

gotoEndOfParagraph()	152

gotoNextParagraph	66, 133, 135, 145, 156p., 163pp.

gotoRange	133, 160, 172

GoToStart	66, 125, 130pp., 147, 151, 156, 163p.

gotoStartOfParagraph()	152

IsCollapsed	124, 128, 131, 147p.

Date	225, 233, 281

DateSerial	270, 282

DateValue	269p., 282

Day	283

DBG_Methods	11, 16

DBG_Properties	11, 16

DBG_SupportedInterfaces	11, 16

Debug

PrintdbgInfo	11

ShowArray	11

WritedbgInfo	11

Declare	283

DefBool	225, 284

DefDate	225, 285

DefDbl	225, 285

DefInt	225, 286

DefLng	225, 286

DefObj	225, 286

DefVar	225, 287

Desktop

CurrentComponent	108

LoadComponentFromURL()	35

Dialog

endExecute	184

execute	183

Dim	225pp., 231p., 287

DimArray	232, 264, 288

Dir	289, 308

dispose	35, 41, 58p., 177, 189, 313

Do...Loop	296

Double	225, 229

Else	237, 315

ElseIf	237, 315

email	77

email

sending email	76

Empty	229p.

End	291

End Function	291

End If	291

End Select	291

End Sub	291

Environ	292

EOF	274, 292, 305

EqualUnoObjects	293

EQV	249, 293p.

Erl	245, 294

Err	245, 295

Error	244, 295

ExampleShell	334

Exit	234, 243

Exit DO	243

Exit For	243

Exit Function	243

Exit Sub	243

Exit Do	239, 296

Exit For	238, 296

Exit Function	242, 296

Exit Sub	242, 297

Exp	297

False	234

Fibonacci	51

FieldMaster	55pp.

File

49

CLOSE	49

FileExists	49

FreeFile	49

LINE INPUT	49

Loc	327

Lof	328

OPEN	49

FileAttr	298

FileCopy	299

FileDateTime	299

FileExists	300

FileLen	300, 328

Find & Replace

createReplaceDescriptor	159, 161

createSearchDescriptor	7, 158pp.

findAll	7

findFirst	7, 158pp.

findNext	7, 158pp.

replaceAll	159, 161

ReplaceDescriptor

ReplaceString	159, 161

SearchDescriptor

searchAll	161

SearchCaseSensitive	158p.

SearchRegularExpression	161

SearchString	158pp.

searchStyles	161

SearchWords	158

SetReplaceAttributes	161

SetSearchAttributes	161

Fix	302

For	238

For...Next	296

Format	305

FreeFile	274, 292, 306

Function	5, 234

GCD	70

Get	307

GetAttr	289, 308

getDocumentInfo	53p.

getImplementationName	15

getNumberFormats()	50

getPathSeparator()	290

GetProcessServiceManager()	309

GetSolarVersion	33

GetSolarVersion()	310

GetSystemTicks()	310

GlobalScope	311

GoSub	237, 242, 311, 315

GoTo	49, 237, 242, 312, 315

GraphicExportFilter	53, 84

GraphicObjectFillBitmap	44

GraphicObjectShape	44, 167

Green	312

GUI	1

hasLocation	35, 37, 52, 91

HasUnoInterfaces	313

Header

HeaderOn	112

HeaderShared	112

Hex	314

Hour	314

IDE	1

IDL	1

If	237, 315

IIf	234, 237, 315

Imp	249, 317

Input	317

Input#	317

InputBox	318

InStr	319

Int	49, 319

Integer	225, 228

Is	234

IsArray	8, 233, 320

IsDate	233, 320

IsEmpty	8, 229p., 233, 321

IsMissing	50, 233, 235, 321

isModified	21, 35, 37, 52

IsNull	8, 208, 230, 233, 322

IsNumeric	233, 323

IsObject	8, 233, 323

isPlugged	97

isReadOnly	21, 35, 37, 52

IsUnoStruct	8, 233, 324

Kill	274, 292, 305, 324

LBound	231, 325

LCase	325

Left	326

Len	29, 49, 326

Let	327

library	6

Line Input	327

LineDistance	109

loadComponentFromURL	35

Loc	328

Locale	65

Country	153

Language	153

Lof	328

Log	329

Long	225, 229

Loop	239

Do	239

Do Until	239

Do While	239

Loop Until	239

Loop While	239

LSet	330

LTrim	331

Macro Author

ADPSetWordCase	162

Andrew Pitonyak

49

AccessModes	299

ADPWordCountCharCursor	138

ADPWordCountStrings	136

ADPWordCountWordCursor	139

BuildSortedArray	210

CalcGroupingExample	112

ClearDefinedRange	102

CloseOpenDocument	313

ColumnNumberToString	105, 208

CreateSelectedTextIterator	131

DecimalFeetToString	71

DisplayAllStyles	29

ExampleNewPage	155

ExampleShell	48

FileAttributeString	309

FindCreateNumberFormatStyle	50

FirstDuplicate	211

ForNextExampleSort	238

GetLeftMostCursor	129

GetRightMostCursor	129

GetSomeObjInfo	9

InsertDateField	154

InsertDateIntoCell	105

InsertSimpleText	153

IsAnythingSelected	128

IsSpreadsheetDoc	101

IsWhiteSpace	133, 307

IterateOverSelectedTextFramework	130

MultipleTextSelectionExample	128

NonBlankCellsInColumn	209

PrintableAddressOfCell	104, 208

PrintableCellAddress	209

PrintAscii	253

PrintDataInColumn	111

PrintEachCharacterWorker	132

ProtectSpreadsheet	112

RankChar	133

Read_Write_Number_In_File	48

RemoveEmptyParsWorker	135

RemoveFromString	252

ReplaceInString	252

SearchSelectedText	159

SelectedNewLinesToSpaces	143

SelectedNewParagraphsToNewLines	144

SetDocumentLocale	66

SetTextAttributes	152

StringToDecimalFeet	72

testOptionalParameters	235

ToFraction	71

Bernard Marcelly

ErrorHandlingExample	246

Birgit Kellner

AtToUnicode	158

Christian Junker	31, 41, 64

Database Columns

David Kwok	116

David Woody

DrawLineInCalcDocument	84

InsertAndPositionGraphic	83

edA-qa mort-ora-y

Fibonacci	51

GetGlobalRangeByName

Rob Gray	114

Hermann Kienlein	41

Laurent Godard

OOoLang	34

OOOVersion	33, 310

SendSimpleMail	77, 278

UnzipAFile	85

Load library

Sunil Menon	80

Marc Messeant

AppliquerStyle	157

Niklas Nebel

setting_borders_in_calc	109

Oliver Brinzing

CopySpreadsheetRange	64

Olivier Bietzer

GCD	70

OpenOffice

GetDocumentType	15

Paolo Mantovani

RetrieveTheActiveCell	104

Paul Sobolik	30

ListFonts	30

Peter Biela	27

Ryan Nelson

CopyPasteRange	64

Sasa Kelecvic

ActiveSheet	108

Analize	107

CellPos	108

DefineDbRange	108

DeleteDbRange	108p.

ExampleGetValue	101

ExampleSetValue	102

FillCells	107

GetAddress	107

ProgressBar	29

SelectedCells	106

SortRange	110

StatusText	29

SetBitMapSize

Vance Lankhaar	81

Stephan Wunderlich

CopySpreadsheet	113

MAX	107

MIN	107

MOD	249

module	6

NOT	234

Null	229p., 233

NumberFormat	50

addNew	50

DATE	50

FindCreateNumberFormatStyle	105, 154

queryKey	50

Object	225, 229p.

OLE	1

OleObjectFactory	48, 77

On Error	49

Local	244

On Error	244

On Error GoTo 0	244

On Error GoTo Label	244

On Error Resume Next	244

Resume	245

Resume Label:	245

Resume Next	245

On Local Error Goto 0	49

On N GoSub	243

On N GoTo	243

OOo	1

Open	49, 274, 292, 305

Option Base	231

Option Explicit	17, 225

Optional	50, 233, 235

OR	234, 249

outline numbering	176

Outlook	77

Outlook.Application	78

PageDescName	155

PageNumberOffset	155

PI	230

PRINT	49

printdbgInfo	3

Private	226p., 331

PropertyValue	110

Name	110

Value	110

Public	226p., 332

Red	332

ReDim	225p., 232p., 287

ReDim

Preserve	232p.

ReDim	232p.

ReDimExample	232

REM	225

Return	242

RSet	333

SDK	1

Select	63

Case	239p.

Case Else	240

Is	240

Select Case	239

To	240

Selection

Columns	107

getRangeAddress	107

Rows	107

ServiceInfo	10

SetExpression	60

setModified	35, 37

Shell	334

SimpleCommandMail	77

SimpleSystemMail	77

Single	225

Sort	110

SortField	110

Field	110

SortAscending	110

SpreadsheetDocument

BottomLine	109

Column

Columns	106p.

getByIndex	106p.

getCount	107

getName	106, 111

Columns	106, 111

Count	102

CurrentSelection	106p.

getByName	101p., 110

getCellByPosition	101p., 107

getCellRangeByName	110

getCellRangeByPosition	109

getCount	106

getName	104, 208p.

getRangeAddress	106

Row

EndRow	106p.

getCount	106p.

Rows	107

StartRow	106p.

Rows	106

setString	107

Sheets	101p., 109pp.

SpreadsheetDocument	101

SupportsService	101

TableBorder	109

StarDesktop	7

Static	227

StatusIndicator

start	29

Str	49

String	225, 229

StyleFamilies	112

Styles

CharacterStyles	29

FrameStyles	29

NumberingStyles	29

PageStyles	29

ParagraphStyles	29

Sub	5, 234

switch	239, 243

SystemShellExecute	90

table of contents	177

TableBorder	109

Tan	266

terminate	34p.

TextContent	168

TextCursor	124

goDown()	124

goLeft()	124

goRight()	124

gotoEnd()	125

gotoStart()	125

goUp()	124

IsCollapsed	124

IsCollapsed()	128

TextCursor	125

TextDocument

compareRegionEnds()	129

compareRegionStarts()	129

createReplaceDescriptor	159

createTextCursorByRange	153

createTextCursorByRange()	128pp., 152

CurrentController	152p.

findFirst	158

findNext	159

getCurrentSelection

getCount()	129

getCurrentSelection()	127pp.

getByIndex()	128p.

getCount()	128

insertControlCharacter	144

insertString	153

Text	152

TextField

Annotation	155

DateTime	154

FieldMaster

attachTextFieldMaster	57

Drawing	56

Illustration	56

Table	56

Text	56

User	55pp.

SheetName	113

URL	59

TextField.SetExpression	60

TextGraphicObject	83, 167

TextRange	124

TextSection	12, 181

Thanks

Alain Viret	15

Andreas Bregas	2, 230, 236

Andrew Brown	136, 140

Andrew McMillan	337

Antal Attila	334

Antoine Jarrige	96

Berend Cornelius	62, 189

Bernard Marcelly	89, 111, 159, 241, 246

Birgit Kellner	158

C Robert Pearsall	2

Chris Clementson	116

Christian Erpelding	29

Christian Junker	2p., 35, 59

Dan Juliano	86

Daniel Juliano	77

Daniel Vogelheim	140

David Woody	109

Eric VanBuggenhaut	96

Erik Anderson	90

Frank Schönheit	183

Frédéric Wenzel	205

Gerrit Jasper	117p., 120

Giuseppe Castagno	171

Hal Vaughan	26

Hermann Kienlein	2p., 17

Hermann-Josef Beckers	2p.

Jean Hollis Weber	2

Jim Thompson	222p.

Jürgen Schmidt	80

Kelvin Eldridge	2

Laurent Godard	2, 81, 85, 87, 89

Leston Buell	213p.

Marc Messeant	68, 157

Mathias Bauer	2, 26, 62, 223

Michelle Pitonyak	2

Mikhail Voitenko	38

Niklas Nebel	109

Oliver Brinzing	112p., 190

Oliver Brinzing	64

Olivier Bietzer	70

Paolo Mantovani	89, 92, 104, 187, 215, 341

Paul Sobolik	30

Peter Biela	27

Rob Gray	114

Robert Black Eagle	2

Rodrigo V Nunes	56

Russ Phillips	78, 90

Ryan Nelson	64, 111

Sasa Kelecevic	2p., 29, 101, 106pp.

Solveig Haugland	2

Stephan Wunderlich	113

Sunil Menon	80

Sven Jacobi	83

Tony Bloomfield	16

Vance Lankhaar	81p.

ThisComponent	7

TimeValue	269

TOC	177

Trim	49

True	234

TypeName	8, 227

UBound	231, 335

UCase	336

UNO	1

Until	329

Val	264

Variant	225, 229, 233, 321

VarType	227

Visual Basic	1

While	329

While...Wend	241

WritedbgInfo	3

XOR	234, 249

XSelectionSupplier	63

11

Andrew's Macro Information

Macro Programming

starbasic Macro

Andrew Pitonyak

2003-02-11T16:41:37

Andrew Pitonyak