October 22, 2005
Macros: A Lotto Number Generator
I have plans to implement a Keno game in the OOo basic language - but first a simple Lotto number generator. If you go into the source, you can configure to your own requirements. Generating a random number between 1 and 49 is really simple. Making sure that number has not already been picked slightly complicates matters.Download it here
Sub Lotto
Dim i
Dim j
Dim val
Dim match
oSheet = ThisComponent.Sheets(1)
For i = 1 To 6
oCell = oSheet.getCellByPosition(1,i)
Do
match = False
val = int(rnd()*49) + 1
For j = 1 To i
If val = oSheet.getCellByPosition(1,j).getValue() Then
match = True
End If
Next j
Loop Until (match = False)
oCell.setValue(val)
Next i
End Sub
Posted by Dave at 10:48 PM | Comments (0)
September 14, 2005
Listing Cell Notes
Here is a simple macro that creates a new sheet in the Calc document with a listing of all the notes (comments) found.Notes can be added to any cell with Insert - Note - see below.
The Basic code for gathering all of these notes and adding them to a new sheet is given below. Items in the listing I'd like to draw your attention to..
- Creating new sheets with the insertNewByName method.
- The PrintableAddressOfCell and ColumnNumberToString routines convert row and column cell offsets to human readable notation - and were written by Andrew Pitonyak.
- The notes (annotations) for each sheet are traversed using a For loop in the exact same way as the sheets of the document.
Sub AddCommentSheet
Dim oSheets, oSheet
Dim oRange, oCell
Dim oAnnotations, oNote
Dim i As Integer
Dim j As Integer
oSheets = ThisComponent.Sheets
oSheets.insertNewByName ("Comments", oSheets.getCOunt())
oSheet = oSheets.getByName("Comments")
oRange = oSheet.getCellRangeByName("B1:C1")
oRange.merge(True)
oCell = oSheet.getCellByPosition(1,0)
oCell.setString("Comment listing")
oCell.CellBackColor = 16764057
oCell.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER
oCell = oSheet.getCellByPosition(1,1)
oCell.setString("Created on ..." & Now())
oCell = oSheet.getCellByPosition(1,3)
oCell.setString("Sheet")
oCell.CellBackColor = 16764057
oCell = oSheet.getCellByPosition(2,3)
oCell.setString("Cell")
oCell.CellBackColor = 16764057
oCell = oSheet.getCellByPosition(3,3)
oCell.setString("Note")
oCell.CellBackColor = 16764057
CurRow = 4
For j = 0 To oSheets.getCount()-1
oSheet2 = oSheets.getByIndex(j)
oAnnotations = oSheet2.getAnnotations()
For i = 0 To oAnnotations.getCount()-1
oNote = oAnnotations.getByIndex(i)
oCell = oSheet.getCellByPosition(1,CurRow+i)
oCell.setString(oSheet2.Name)
oCell = oSheet.getCellByPosition(2,CurRow+i)
oCell.setString(PrintableAddressOfCell(oNote.getParent())
oCell = oSheet.getCellByPosition(3,CurRow+i)
oCell.setString(oNote.getString())
Next
CurRow = CurRow + i
Next
End Sub
Function PrintableAddressOfCell(oCell) As String
If IsNull(oCell) OR IsEmpty(oCell) Then
PrintableAddressOfCell = "Unknown"
Else
PrintableAddressOfCell = ColumnNumberToString(oCell.CellAddress.Column) &_
Cstr(oCell.CellAddress.Row+1)
End If
End Function
Function ColumnNumberToString(ByVal nColumn As Long) As String
Dim s As String
Do While nColumn >= 0
s = Chr$(65 + (nColumn MOD 26)) & s
nColumn = nColumn \ 26 - 1
Loop
ColumnNumberToString = s
End Function
The newly created comment sheet is shown below.
Posted by Dave at 10:09 PM | Comments (0)
August 29, 2005
Macros: Text Utilities Part I
It is straightforward to enhance the capabilities of OOo Calc with your home grown functions and features. In this tip, we add the ability to change the case of the text in a range of selected cells.(UPPER CASE, lower case or Proper Case).As you can in the screenshot below, we have added a new top level menu item TextUtils with 3 new functions, UpperC, LowerC, and ProperC. The last function capitalizes the first character only.
We could have invoked these functions with Tools - Macros etc but from a user's standpoint, it is much more convenient to invoke them the way we have implemented it.
Pretty straightforward - the results of applying UpperC to the selected cells.
First - the source code...
Sub UpperC
oDesktop = createUnoService("com.sun.star.frame.Desktop")
oDocument = ThisComponent
oSelectedCells = oDocument.CurrentSelection
oActiveCells = oSelectedCells.RangeAddress
oSheets = oDocument.Sheets
oSheet = oSheets.getByIndex(oActiveCells.Sheet) ' active table
For nRow = oActiveCells.StartRow To oActiveCells.EndRow
For nCol = oActiveCells.StartColumn To oActiveCells.EndColumn
oCell = oSheet.getCellByPosition(nCol,nRow)
CellVal = oCell.getString()
oCell.setString(UCase(CellVal))
Next
Next
End Sub
Sub LowerC
oDesktop = createUnoService("com.sun.star.frame.Desktop")
oDocument = ThisComponent
oSelectedCells = oDocument.CurrentSelection
oActiveCells = oSelectedCells.RangeAddress
oSheets = oDocument.Sheets
oSheet = oSheets.getByIndex(oActiveCells.Sheet) ' active table
For nRow = oActiveCells.StartRow To oActiveCells.EndRow
For nCol = oActiveCells.StartColumn To oActiveCells.EndColumn
oCell = oSheet.getCellByPosition(nCol,nRow)
CellVal = oCell.getString()
oCell.setString(LCase(CellVal))
Next
Next
End Sub
Sub ProperC
oDesktop = createUnoService("com.sun.star.frame.Desktop")
oDocument = ThisComponent
oSelectedCells = oDocument.CurrentSelection
oActiveCells = oSelectedCells.RangeAddress
oSheets = oDocument.Sheets
oSheet = oSheets.getByIndex(oActiveCells.Sheet) ' active table
For nRow = oActiveCells.StartRow To oActiveCells.EndRow
For nCol = oActiveCells.StartColumn To oActiveCells.EndColumn
oCell = oSheet.getCellByPosition(nCol,nRow)
CellVal = oCell.getString()
oCell.setString(UCase(Left(CellVal,1)) & Right(CellVal,Len(CellVal) - 1) )
Next
Next
End Sub
Creating the new menu entries is simple. Invoke the Menu Customization dialog with Tools - Customize as shown below...
Select the Menus tab. Add a new top level menu item - TextUtils and then a seperate entry for each of our new functions.
Here is the Add Commands dialog. We select the module in the left hand box and the macro subroutine on the right. By default, the menu entry is given the same name as the subroutine but hat can be changed.
In the next installment, we will add a dialog to enhance out new functionality even further.
Posted by Dave at 09:50 PM | Comments (0)
August 23, 2005
Spelling out numbers
A simple macro that converts a numeric value to it's English equivalent.The function GetDigit converts a single digit...
Function GetDigit(Digit)
Select Case Val(Digit)
Case 1: GetDigit = "One"
Case 2: GetDigit = "Two"
Case 3: GetDigit = "Three"
Case 4: GetDigit = "Four"
Case 5: GetDigit = "Five"
Case 6: GetDigit = "Six"
Case 7: GetDigit = "Seven"
Case 8: GetDigit = "Eight"
Case 9: GetDigit = "Nine"
Case Else: GetDigit = ""
End Select
End Function
The function GetTens handles numbers from 10 to 99.
Function GetTens(TensText)
Dim Result As String
Result = ""
If Val(Left(TensText, 1)) = 1 Then
Select Case Val(TensText)
Case 10: Result = "Ten"
Case 11: Result = "Eleven"
Case 12: Result = "Twelve"
Case 13: Result = "Thirteen"
Case 14: Result = "Fourteen"
Case 15: Result = "Fifteen"
Case 16: Result = "Sixteen"
Case 17: Result = "Seventeen"
Case 18: Result = "Eighteen"
Case 19: Result = "Nineteen"
Case Else
End Select
Else ' If value between 20-99...
Select Case Val(Left(TensText, 1))
Case 2: Result = "Twenty "
Case 3: Result = "Thirty "
Case 4: Result = "Forty "
Case 5: Result = "Fifty "
Case 6: Result = "Sixty "
Case 7: Result = "Seventy "
Case 8: Result = "Eighty "
Case 9: Result = "Ninety "
Case Else
End Select
Result = Result & GetDigit(Right(TensText, 1))
End If
GetTens = Result
End Function
The function GetHundreds extends the concept to numbers from 100 to 999...
Function GetHundreds(ByVal MyNumber)
Dim Result As String
If Val(MyNumber) = 0 Then Exit Function
MyNumber = Right("000" & MyNumber, 3)
' Convert the hundreds place.
If Mid(MyNumber, 1, 1) <> "0" Then
Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
End If
' Convert the tens and ones place.
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & GetTens(Mid(MyNumber, 2))
Else
Result = Result & GetDigit(Mid(MyNumber, 3))
End If
GetHundreds = Result
End Function
Finally, a macro that converts a dollar amount to English...
Function SpellNumber(ByVal MyNumber)
Dim Dollars, Cents, Temp
Dim DecimalPlace, Count
Dim Place(9) As String
Place(2) = " Thousand "
Place(3) = " Million "
Place(4) = " Billion "
Place(5) = " Trillion "
' String representation of amount.
MyNumber = Trim(Str(MyNumber))
' Position of decimal place 0 if none.
DecimalPlace = InStr(MyNumber, ".")
' Convert cents and set MyNumber to dollar amount.
If DecimalPlace > 0 Then
Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
"00", 2))
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
Count = 1
Do While MyNumber <> ""
Temp = GetHundreds(Right(MyNumber, 3))
If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Select Case Dollars
Case ""
Dollars = "No Dollars"
Case "One"
Dollars = "One Dollar"
Case Else
Dollars = Dollars & " Dollars"
End Select
Select Case Cents
Case ""
Cents = " and No Cents"
Case "One"
Cents = " and One Cent"
Case Else
Cents = " and " & Cents & " Cents"
End Select
SpellNumber = Dollars & Cents
End Function
Posted by Dave at 10:13 PM | Comments (0)
March 03, 2005
Macro : Sorting sheets
A simple macro for sorting sheets in a spreadsheet in ascending alphabetical order.
Sub SortSheets
Dim oSheets
Dim oSheet
Dim i As Integer
Dim swap As Boolean
oSheets = ThisComponent.Sheets
If oSheets.getCount() > 1 Then 'No sorting for one sheet
Do
swap = False 'We continue bubble sort passes until no more swaps
For i = 0 to oSheets.getCount()-2
If oSheets.getByIndex(i).Name >
oSheets.getByIndex(i+1).Name Then
oSheets.moveByName(oSheets.getByIndex(i+1).Name,i)
swap = True
End If
Next
Loop Until swap = False
End If
End Sub
Posted by Dave at 04:02 AM | Comments (1)
November 24, 2004
Macros: Getting Cell Information
Invariably, macros written for use within the Calc application will need to access the contents of the cells on a spreadsheet. This tip is an introduction to the various available methods.The three methods we will look at are getCellByPosition, getCellRangeByPosition and getCellRangeByName
The function that is first encountered for most people is getCellByPosition. In the sample below, we access cell A1 (on Sheet1)
Sub getCellInfo
'get the first sheet of the spreadsheet doc
xSheet = ThisComponent.Sheets(0)
'Get value of Cell A1
A1_value = xSheet.getCellByPosition(0,0).value
print A1_value
End Sub
The second example shows the use of getCellRangeByName and may be easier to use - because the cells are referenced by the traditional column/row identifiers that are displayed along each axis. However, for applications requiring looping through an array of cells, getCellByPosition is easier to use.
Sub getCellInfo
'get the first sheet of the spreadsheet doc
xSheet = ThisComponent.Sheets(0)
'Get value of Cell A3
A3_value = xSheet.getCellRangeByName("A3").value
print A3_value
End Sub
The next example shows how getCellInfo grabs an array of cells - myTable. A subsequent call to getCellByPosition for the myTable object is relative to the origin of this array.
Sub getCellInfoByRange
Dim myTable as Object
'get the first sheet of the spreadsheet doc
xSheet = ThisComponent.Sheets(0)
'Grab array A3:A5
myTable = xSheet.getCellRangeByName("A3:A5")
A5_value = myTable.getCellByPosition(0,2).value
print A5_value
End Sub
Dim myTable as Object
'get the first sheet of the spreadsheet doc
xSheet = ThisComponent.Sheets(0)
'Grab array A3:A5
myTable = xSheet.getCellRangeByName("A3:A5")
A5_value = myTable.getCellByPosition(0,2).value
print A5_value
End Sub
The final method that needs discussion is getCellRangeByPosition and the example below illustrates it's use. It is equivalent in functionality to the previous example.
Sub getCellInfoByRange
Dim myTable as Object
'get the first sheet of the spreadsheet doc
xSheet = ThisComponent.Sheets(0)
'Grab array A3:A5
myTable = xSheet.getCellRangeByPosition(0,2,0,4)
A5_value = myTable.getCellByPosition(0,2).value
print A5_value
End Sub
Dim myTable as Object
'get the first sheet of the spreadsheet doc
xSheet = ThisComponent.Sheets(0)
'Grab array A3:A5
myTable = xSheet.getCellRangeByPosition(0,2,0,4)
A5_value = myTable.getCellByPosition(0,2).value
print A5_value
End Sub
For more information.. http://api.openoffice.org/docs/common/ref/com/sun/star/table/XCellRange.html
Posted by Dave at 03:09 PM | Comments (1)
November 12, 2004
Macros: A simple clock
Here is another simple macro that turns an OOo Calc spreadsheet into a real time clock.The OpenOffice Basic builtin function Now returns the current date and time as a Date value. By embedding this function inside an infinite WHILE loop, we simulate a clock. The code is shown below.
Sub DisplayTime
Dim oDoc As Object
Dim oSheet As Object
Dim oCell As Object
oDoc=ThisComponent
oSheet=oDoc.Sheets.getByName("Sheet1")
) oCell=oSheet.getCellByposition(1,1) 'B2
Do
oCell.SetString(Now)
Wait 1000
Loop While 1
End Sub
Dim oDoc As Object
Dim oSheet As Object
Dim oCell As Object
oDoc=ThisComponent
oSheet=oDoc.Sheets.getByName("Sheet1")
) oCell=oSheet.getCellByposition(1,1) 'B2
Do
oCell.SetString(Now)
Wait 1000
Loop While 1
End Sub
The output to the spreadsheet is shown below.
Posted by Dave at 04:57 AM | Comments (0)
September 09, 2004
A simple recursive macro: GCD
In mathematics, the greatest common divisor (abbreviated GCD), or highest common factor (HCF) of two integers which are not both zero is the largest integer that divides both numbers.
The GCD of a and b is often written as gcd(a,b) or simply (a,b). For example, gcd(12,18) = 6, gcd(-4,14) = 2 and gcd(5,0) = 5. Two numbers are called coprime or relatively prime if their greatest common divisor equals 1. For example, 9 and 28 are relatively prime.
The greatest common divisor is useful for writing fractions in lowest terms.
The algorithm for determining the GCD of two numbers is known as a recursive algorithm - and the OpenOffice Basic code is listed below..
Function gcd(a As Integer, b As Integer) As Integer
If b = 0 Then
gcd = a
Else
gcd = gcd(b,a)
End If
End Function
Posted by Dave at 05:42 AM | Comments (2)
September 07, 2004
Macros: Prime numbers
Here is another few simple macros - written in OpenOffice Basic. First we have a primality test ...
Function IsPrime(Val As Integer) As Boolean
Dim I As Integer
IsPrime = FALSE
For I = 2 To Val - 1
If Val MOD I = 0 Then
Exit Function
End If
Next I
IsPrime = TRUE
End Function
The second macro finds the next highest prime.
Function NextHighestPrime(Val As Integer) As Integer
Dim I As Integer, PrimeFound As Boolean
I = Val
NextHighestPrime = Val
PrimeFound = FALSE
Do While PrimeFound = FALSE
I = I + 1
If IsPrime(I) = TRUE Then
PrimeFound = TRUE
NextHighestPrime = I
End If
Loop
End Function
Posted by Dave at 05:28 AM | Comments (2)
September 06, 2004
A Simple Macro: Fibonacci Numbers
When learning a new (computer) language - it is important to have a good mastery of the basics. Developing simple functions like this is what is called for here.
Function Fibonacci(Val As Integer) As Long
Dim I As Integer
Fibonacci = 1
For I = 1 To Val
Fibonacci = Fibonacci * I
Next I
End Function
We can now call our newly created function from the spreadsheet - just like the builtin OOo Calc functions.
Posted by Dave at 04:34 AM | Comments (4)