The following code appears in "Merge Cells" Macro available in this Forum.
Code: Select all
Function getCurrentRegion(oRange)
Dim oCursor
oCursor = oRange.getSpreadSheet.createCursorByRange(oRange)
oCursor.collapseToCurrentRegion
getCurrentRegion = oCursor
End Function
- There is a sheet [Accumulator] on the left to accumulate data from each sheet on the right in a document.
- The cursor is always placed at the start of data on a sheet on the right. [DataSheets]
- The DataSheet has the same headers on all sheets, like Serial Number, Date, Doc No, Type, Remarks, Amount
[*}The Data always begins at a specific row say A7, on the DataSheet - There are no blank rows in between the data.
- The Function selects the data
- Copies the data to the Accumulator on the left
- Leaves a blank row on the accumulator sheet for the next data set
- Then select the data on the next Datasheet
- Copy it to the Accumulator sheet. leaving one blank row. for the next data set
- The macro continues to select and copy the data to the Accumulator till the last Datasheet.
It is well above the level of a beginner.
So I have to take each Function and check how it works and then customize it to my needs.
I am beginning with the CurrentRegion Function which I wish to study.
Thanks you very much for all the help given earlier.
I have reproduced the Merge Cells Macro below...hats off to the person who wrote it.
Code: Select all
REM This macro is derived from Merge sheets of spreadsheet documents. That macro is embedded in a spreadsheet template.
REM It reads spreadsheet files from a folder and merges the used areas of a specific sheet below a specified target cell within the document embedding
REM the macro code.
REM Here is another variant that reads the used areas of selected sheets and writes the raw data below a specified target cell.
REM Because it is supposed to work with any spreadsheet document (not just the embedding document), you save the code somewhere in your global container "My Macros" and perform the following steps:
REM 1. Define a target sheet by specifying a cell named "Target". The name or position of the sheet does not matter.
REM Just give the "Target" name to one of its cells.
REM How to: click the wanted cell and type the name into the name box left of the formula bar.
REM 2. Optional: Define a named cell "Headers" where you enter the amount of header rows to be skipped. If you don't specify this cell, all rows will be merged.
REM 3. Select all the sheets you want to be merged below the target cell. The sheet with the target cell won't be merged even if it is selected.
REM 4. Call the Main routine of the below code.
REM The macro reads the used areas of all selected sheets skipping the target sheet if it is selected too, subtracts the specified
REM amount of header rows and dumps the raw data (strings and values, no formulas nor formattings) below the current region of the target cell.
REM The data will be dumped with one column offset because the first column below the target cell gets the name of
REM the source sheet so you won't lose any information.
REM ***** BASIC *****
REM ***** BASIC *****
Option Explicit
Const cCaller = "macro:SheetMerge.Main" 'error title
Const cMsg = "Please select one or more sheets other than the target sheet." 'error text
Const cTarget = "Target" 'cell name of target cell
Const cSkipRange = "Headers" 'cell name specifying the header rows count, default=0
Dim oCurrRegion, nSkip%
Sub Main()
'calls: getNamedCell, getCurrentRegion, getSheetIndices, processSheet
REM insert used ranges of selected sheets
REM into to the current region of the active cell
Dim oCell, oSel, addr
Dim a(), aI(), i%, xSheet%
Dim oSettings, bExpand As Boolean
REM define target area as first row below current region
REM around the cell named "Target"
oSettings = createUnoService("com.sun.star.sheet.GlobalSheetSettings")
bExpand = oSettings.ExpandReferences
oSettings.ExpandReferences = True
oCell = getNamedCell(ThisComponent, cTarget)
if ThisComponent.NamedRanges.hasByName(cSkipRange) then _
nSkip = cInt(getNamedCell(ThisComponent, cSkipRange).getValue())
oCurrRegion = getCurrentRegion(oCell)
addr = oCurrRegion.getRangeAddress()
xSheet = addr.Sheet
REM define source areas
oSel = ThisComponent.getCurrentSelection()
if oSel.supportsService("com.sun.star.sheet.SheetCellRange") then
if oSel.RangeAddress.Sheet = xSheet then
MsgBox cMsg, 16, cCaller
oSettings.ExpandReferences = bExpand
exit sub
else
a() = Array(oSel.getRangeAddress())
endif
elseif oSel.supportsService("com.sun.star.sheet.SheetCellRanges") then
a() = oSel.getRangeAddresses()
else
MsgBox cMsg, 16, cCaller
oSettings.ExpandReferences = bExpand
exit sub
endif
aI() = getSheetIndices(a())
for each i in aI()
if i <> xSheet then
processSheet(ThisComponent.Sheets.getByIndex(i))
endif
next
oSettings.ExpandReferences = bExpand
End Sub
Sub processSheet(oSheet)
'calls: getUsedRange, getRangeByAddress
Dim urg, src, rg, a(), x, y, adr, sh
urg = getUsedRange(oSheet)
src = urg.getRangeAddress()
src.StartRow = src.StartRow + nSkip
rg = getRangeByAddress(oSheet, src)
if not isObject(rg) then exit sub
a() = rg.getDataArray()
x = uBound(a())
y = uBound(a(0))
adr = oCurrRegion.getRangeAddress()
adr.EndColumn = adr.StartColumn + y +1
adr.StartRow = adr.StartRow +1
adr.StartRow = adr.EndRow +1
adr.EndRow = adr.StartRow + x
sh = oCurrRegion.getSpreadsheet()
' print rg.absolutename
sh.insertCells(adr, com.sun.star.sheet.CellInsertMode.DOWN)
adr.StartColumn = adr.StartColumn +1
rg = getRangeByAddress(sh, adr)
rg.setDataArray(a())
adr.StartColumn = adr.StartColumn -1
adr.EndColumn = adr.StartColumn
rg = getRangeByAddress(sh, adr)
rg.getCellByPosition(0,0).setString(oSheet.getName())
rg.fillSeries(com.sun.star.sheet.FillDirection.TO_BOTTOM, com.sun.star.sheet.FillMode.SIMPLE,0,0,0)
oCurrRegion = getCurrentRegion(oCurrRegion)
end sub
Function getNamedCell(doc, s)
REM get named cell or top-left cell of a named range
Dim nx, obj
nx = doc.NamedRanges
obj = nx.getByName(s)
getNamedCell = obj.getReferredCells.getCellByPosition(0,0)
End Function
'pass a spreadsheet-document, sheet or range together with a c.s.s.table.CellRangeAddress
'return empty if oAddr out of bounds or wrong obj
Function getRangeByAddress(obj, oAddr as com.sun.star.table.CellRangeAddress)
on error goto nullErr:
Dim oSheet
If obj.supportsService("com.sun.star.sheet.SpreadsheetDocument") then
REM use the sheet specified by given address
oSheet = obj.getSheets.getByIndex(oAddr.Sheet)
else
REM use given object (range/sheet) as parent range
oSheet = obj
endif
getRangeByAddress = oSheet.getCellRangeByPosition(oAddr.StartColumn,oAddr.StartRow,oAddr.EndColumn,oAddr.EndRow)
exit function
nullErr:
getRangeByAddress = Null
End Function
Function getUsedRange(oSheet)
Dim oCursor
oCursor = oSheet.createCursor()
oCursor.gotoStartOfUsedArea(False)
oCursor.gotoEndOfUsedArea(True)
getUsedRange = oCursor
End Function
Function getCurrentRegion(oRange)
Dim oCursor
oCursor = oRange.getSpreadSheet.createCursorByRange(oRange)
oCursor.collapseToCurrentRegion
getCurrentRegion = oCursor
End Function
Function getSheetIndices(aAddr())
'calls bas_PushArray
REM get unique sheet indeces from array of range addresses
Dim a(), n%, x%, addr
n = -1
for each addr in aAddr()
x = addr.Sheet
if x > n then bas_PushArray(a(), x)
n = x
next addr
getSheetIndices = a()
End Function
'_____________other generic function, not spreadsheet-specific____________________________________________
'very simple routine appending one single element to an array which may be undimensioned (LBound > UBound)
Sub bas_PushArray(xArray(),vNextElement)
Dim iUB%,iLB%
iLB = lBound(xArray())
iUB = uBound(xArray())
If iLB > iUB then
iUB = iLB
redim xArray(iLB To iUB)
else
iUB = iUB +1
redim preserve xArray(iLB To iUB)
endif
xArray(iUB) = vNextElement
End SubPlease note this much, it is not my intention to ask for the complete Macro Code for copying / transferring data from the Data Sheets to the Accumulator Sheet.
This I will do myself, even though it is going to be an uphill task.
If any one of you could direct me to the documentation, with examples for some of the functions used in the Merge Cells Macro it will be fine. Rest I will do myself.
I tried to search on the net but that did not help.
The following Function needs some documentation.
- [1] Function getUsedRange(oSheet)
[2] Function getCurrentRegion(oRange)
Thank you so much for replying to my posts.
These were the other methods I was looking for, and I am glad I found them in the link provided by you folks.
- The method createCursor() creates a cursor that spans over the whole spreadsheet.
- The method createCursorByRange() creates a cursor that spans over the given cell range.
Code: Select all
// *** Use the cell cursor to add some data below of the filled area ***
// Move to the last filled cell.
xCursor.gotoEnd();
// Move one row down.
xCursor.gotoOffset(0, 1);
xCursor.getCellByPosition(0, 0).setFormula("Beyond of the last filled cell.");
There is one more Operator which I use to pick records in Ms Excel, for matching records with a certain criteria.Rem SRC is the name of sheet.
lastRow = src.Cells(Cells.Rows.Count, "E").End(xlUp).Row
Now I got to find out the equivalent in Open Office.
It is called the Union.
But for now I am marking this post as [Solved] will come back if need be.If CopyRange Is Nothing Then
Set CopyRange = c.EntireRow
Else
Set CopyRange = Union(CopyRange, c.EntireRow)
End If
Thank you all once again, have a nice week end.
Regards and thanks
