Thursday, October 12, 2006

revised Search

Here is the Search function from before, revised to include the macro SheetObj. SheetObj and SheetName are in other posts here. (Both the start and the end of the macro have been changed, the latter for date searches.)

Function FindTriple(trange, tsheet, c, r, tname, tname2, offset2, tname3, offset3, n, go)
'if c (or r) is a number, look for nth occurence in column c (or row r) of trange on tsheet
'with tname2 offset offset2 cols and tname3 offset offset3 cols
'columns and rows start at 0 ... c and r are initially range (not sheet) references
'before calling function, set r (or c) to "" to search all rows (or all columns)
'returns sheet (not range) col c and row r where found, or if not found first cell of searched range,
'or ... col and row of last cell where found (for n > 1)
'trange can be chosen as "" to search entire sheet or an entire column or row
'if both trange and tsheet are "", current selection is searched
'tname2 or tname3 can be chosen as "" for simpler searches

FindTriple = 0
oDoc = ThisComponent
dim clrw(3)
oSheet = SheetObj(trange,tsheet,clrw())

if isnumeric(c) then clrw(0) = clrw(0) + c : clrw(2) = clrw(0)'to search in only one column
if isnumeric(r) then clrw(1) = clrw(1) + r : clrw(3) = clrw(1)'to search in only one row
oRange = oSheet.getcellrangebyposition(clrw(0), clrw(1), clrw(2), clrw(3))
oCell = oSheet.getcellbyposition(clrw(0), clrw(1))
c = clrw(0)'change from range coordinates to sheet coordinates
r = clrw(1)

k = 0
if tname = oCell.string then gosub FoundOne

xSearchD = oRange.createSearchDescriptor()
With xSearchD
.SearchString = tname
.SearchCaseSensitive = false
.SearchWords = true 'forces the entire cell to contain only the search string
End With

do
xFound = oCell
xFound = oRange.findNext(xFound, xSearchD)
if IsNull(xFound) then exit do
oCell = xFound
gosub FoundOne
loop
exit function

FoundOne:
c = oCell.rangeaddress.startcolumn
r = oCell.rangeaddress.startrow
temp2 = oSheet.getcellbyposition(c + offset2,r).string
temp3 = oSheet.getcellbyposition(c + offset3,r).string

if len(tname2) > 2 and temp2 <> tname2 then return

if len(tname3) < 2 then
k = k + 1
else
if isdate(tname3) and isdate(temp3) then
temp = DateDiff("d",tname3,temp3)
if temp > 1 and temp < 5 then k = k + 1
else
if temp3 = tname3 then k = k + 1
end if
end if
If k = n Then
FindTriple = -1
If go Then
oCell = oSheet.getcellbyposition(c,r)
oDoc.getCurrentController.select(oCell)
End If
exit function
End If
Return
End Function

Tuesday, October 10, 2006

Open dialog

From my limited experience, it seems that all the macros that refer to a given dialog have to be on the same page (ie the same basic module). A library can have quite a few other basic module (pages). Mine has modules named: Main, Merger, NewYear, Place, Refresh, Search, SimCity, SSum, and Taxes. (The macro in the SimCity module is to sort and reformat a range containing info on rewards and other plop-able "buildings" in SimCity4.) There is also a dialog module in the library called Dialog1. Here's the beginning of the Main module with a macro which opens a dialog with some hidden controls and a combo box populated with elements from a range in a document. The library itself is called "Accounts".

Dim oDialog1 as Object
dim oControl as Object
dim oDoc as Variant

Sub Dialog1Show '---------------open Dialog1, populate ComboBroker----------------------
oDoc = ThisComponent
DialogLibraries.LoadLibrary( "Standard" )
oDialog1 = CreateUnoDialog( DialogLibraries.Accounts.Dialog1 )
oControl = oDialog1.getcontrol("ComboBroker")

oSheet = ThisComponent.Sheets.getbyname("Misc")
oRange = oSheet.getcellrangebyname("Brokers")

for j = 1 to oRange.rows.count -1'first line is column heading
temp = oRange.getcellbyposition(0,j).string
oControl.additem(temp,0)
next

'make option buttons invisible
for j = 1 to 5
oDialog1.getcontrol("OptionButton" & j).setvisible(0)
next
oDialog1.getcontrol("ComboCorrection").setvisible(0)

oDialog1.Execute()

End Sub

Monday, October 09, 2006

Sheet object

After I found myself copying the first few lines of the search macro into another macro, I decided to make them into their own macro.

Function SheetObj(trange,tsheet,clrw())
'trange can be chosen as "" to get entire sheet and coordinates for entire sheet, not just range on sheet
'if both trange and tsheet are "", current selection is searched
'do not "dim clrw(3)"here, it's equivalent to putting redim clrw(3) at the end of the macro
oSheets = ThisComponent.sheets
oRanges = ThisComponent.namedranges
if oSheets.hasbyname(tsheet) then
SheetObj = oSheets.getbyname(tsheet)
oRange = SheetObj'changed later if trange <> ""
else
if oRanges.hasbyname(trange) then
tsheet = SheetName(trange,0)
SheetObj = oSheets.getbyname(tsheet)
else
SheetObj = ThisComponent.CurrentController.getActiveSheet
oRange = ThisComponent.getcurrentselection()
end if
end if

if oRanges.hasbyname(trange) and trange <> "" then oRange = SheetObj.getcellrangebyname(trange)
if isnull(oRange) then oRange = SheetObj

with oRange.rangeaddress
clrw(0) = .startcolumn
clrw(1) = .startrow
clrw(2) = .endcolumn
clrw(3) = .endrow
end with
end function

Friday, October 06, 2006

Find number in string; also Sort

The first macro finds the first number (not a single digit but an entire number) in a string. The second sorts a range which may or may not have a header.

Function FindNum(ttext)
'returns the first number expression in ttext
n = 1
Do While n <> " " then exit do
n = n + 1
Loop
FindNum = Val(Mid(ttext, n))
end Function

Sub Sorting(trange,tsheet,c1,c2,c3,dir1,dir2,dir3,header)
myarray1 = Array(c1,c2,c3)'range cols start w 0 as the first one
myarray2 = Array(dir1,dir2,dir3)'dir = true for ascending or false otherwise
n = -isnumeric(c1) - isnumeric(c2) - isnumeric(c3)
if n = 0 then exit sub
Dim aSortFields(n) as New com.sun.star.util.SortField
Dim aSortDesc(1) as New com.sun.star.beans.PropertyValue

oSheet = ThisComponent.Sheets.getByName(tsheet)
oRange = oSheet.getCellRangeByName(trange)

for j = 0 to n-1
aSortFields(j).Field = myarray1(j)
aSortFields(j).SortAscending = myarray2(j)
next

aSortDesc(0).Name = "SortFields"
aSortDesc(0).Value = aSortFields()
aSortDesc(1).Name = "ContainsHeader"
aSortDesc(1).Value = header

oRange.Sort(aSortDesc())
End Sub

Wednesday, October 04, 2006

Current / used area

a very short macro

Sub FindRange(tsheet, c1, r1, c2, r2, ttype)
'finds end of either current or used area
oSheet = ThisComponent.sheets.getbyname(tsheet)
oCell = oSheet.getcellbyposition(c1,r1)
oCursor = oSheet.createCursorbyrange(oCell)

if ttype = "current" then
oCursor.gotoEnd
elseif ttype = "used" then
oCursor.gotoEndOfUsedArea(true)
end if

c2 = oCursor.rangeaddress.endcolumn
r2 = oCursor.rangeaddress.endrow
End Sub

Tuesday, October 03, 2006

Search

This macro searches records in a range to find a record that matches up to 3 criteria. The function itself returns true or false. If the first criteria one wants to match is in range column 0, for example, before calling the function, set c = 0 and r = "". If the record is found, the sheet column and row of the found record will be returned as well. This also does simple searches. (FindSheet is a function. It returns the name of a sheet that a given range is on.)

Function FindTriple(trange, tsheet, c, r, tname, tname2, offset2, tname3, offset3, n, go) as Boolean
'if c (or r) is a number, look for nth occurence in column c (or row r) of trange on tsheet
'with tname2 offset offset2 cols and tname3 offset offset3 cols
'columns and rows start at 0 ... c and r are initially range (not sheet) references
'before calling function, set r (or c) to "" to search all rows (or all columns)
'returns sheet (not range) col c and row r where found, or if not found first cell of searched range,
'or ... col and row of last cell where found (for n > 1)
'trange can be chosen as "" to search entire sheet
'if both trange and tsheet are "", current selection is searched
'tname2 or tname3 can be chosen as "" for simpler searches

FindTriple = 0
oDoc = ThisComponent

if oDoc.sheets.hasbyname(tsheet) then
oSheet = oDoc.sheets.getbyname(tsheet)
if oDoc.NamedRanges.hasByName(trange) then
oRange = oSheet.getcellrangebyname(trange)
else
oRange = oSheet
end if
else
if oDoc.NamedRanges.hasByName(trange) then
tsheet = FindSheet(trange,0)
oSheet = oDoc.sheets.getbyname(tsheet)
oRange = oSheet.getcellrangebyname(trange)
else
oSheet = oDoc.CurrentController.getActiveSheet
oRange = oDoc.getcurrentselection()
if isnull(oRange) then oRange = oSheet
end if
end if

with oRange.rangeaddress
c1 = .startcolumn
c2 = .endcolumn
r1 = .startrow
r2 = .endrow
end with

if isnumeric(c) then c1 = c1 + c : c2 = c1'to search in only one column
if isnumeric(r) then r1 = r1 + r : r2 = r1'to search in only one row
oRange = oSheet.getcellrangebyposition(c1, r1, c2, r2)
oCell = oSheet.getcellbyposition(c1, r1)
c = c1
r = r1
k = 0
if tname = oCell.string then gosub FoundOne

xSearchD = oRange.createSearchDescriptor()
With xSearchD
.SearchString = tname
.SearchCaseSensitive = false
.SearchWords = true
REM SearchWords forces the entire cell to contain only the search string
'from Andrew Pitonyak's ooDocument. He used bWholeWord instead of true
'.SearchWords = bWholeWord
End With

do
xFound = oCell
xFound = oRange.findNext(xFound, xSearchD)
if IsNull(xFound) then exit do
oCell = xFound
gosub FoundOne
loop
exit function

FoundOne:
c = oCell.rangeaddress.startcolumn
r = oCell.rangeaddress.startrow
temp2 = oSheet.getcellbyposition(c + offset2,r).string
temp3 = oSheet.getcellbyposition(c + offset3,r).string
if (len(tname2) < 2 or temp2 = tname2) _
and (len(tname3) < 2 or temp3 = tname3) then k = k + 1
If k = n Then
FindTriple = -1
If go Then
oCell = oSheet.getcellbyposition(c,r)
oDoc.getCurrentController.select(oCell)
End If
exit function
End If
Return
End Function

Monday, October 02, 2006

Create range, Column number to letter, Rounding

Three short macros ... The first creates a named range. The second converts a column number to a letter. (Note: Column 0 is column A, column 26 is column AA. Also, row 0 is row 1.) The third rounds a number to n decimal places.

Sub NewRange(trange, tsheet, c1, r1, c2, r2)
'defines trange on tsheet with these coordinates
if trange = "" then exit sub
r1 = r1 + 1 : r2 = r2 + 1
temp = "$" & tsheet &amp;amp;amp; ".$" & Letter(c1) & "$" & r1 & ":$" & Letter(c2) & "$" & r2
with ThisComponent.NamedRanges
If .hasByName(trange) Then .removeByName (trange)
.addNewByName(trange, temp, createUnoStruct( "com.sun.star.table.CellAddress" ),0 )
end with
r1 = r1 - 1 : r2 = r2 - 1
End Sub

Function Letter(c)
temp = Int(c/26)
if temp > 0 then Letter = Chr(64 + temp) else Letter = ""
Letter = Letter & Chr(65 + c - 26 * temp)
End Function

Function Rounding(x,n)' rounds x to n decimal places
Rounding = int(x * 10^n)/10^n
end Function