Villeroy
Super User
Joined: 04 Oct 2004
Posts: 10065
Location: Germany
|
 Posted: Thu Dec 01, 2005 6:43 pm Post subject: detecting (some) celltypes |
 |
|
May be useful before exporting to dBase among other things.
I have a problem detecting booleans in a localized context, see comment in getMyType(). But bool-detection works with cells explicitly formatted as boolean.
| Code: | REM ***** BASIC *****
REM The return-values of getMyType and sheet-function FNC_TYPE() are similar to those of cell-function TYPE(ref)
' 8 indicates a date/time, instead of formula. The results are independ of formula or value
Public Const myNumberFlag% = 1
Public Const myStringFlag% = 2
Public Const myBoolFlag% = 4
Public Const myDateTimeFlag% = 8
Public Const myErrorFlag% = 16
'vSheet: Name or Index(base 1) of sheet
'lRowIndex: Index(base 1) of row
'lColIndex: Index(base 1) of column
'referencing: =FNC_TYPE("Sheet2";ROW();COLUMN()) 'this row, this column on sheet2
' =FNC_TYPE("Sheet2";ROW();COLUMN()) 'this row, this column on sheet2
' =FNC_TYPE(SHEET();ROW();1) 'this row, column 1 on this sheet
' =FNC_TYPE(SHEET();5;COLUMN()) 'row 5, this column on this sheet
' =FNC_TYPE(SHEET();ROW(C2);COLUMN(C2))'relative refererence to the position of C2 on this sheet
Function FNC_TYPE(vSheet,lRowIndex&,iColIndex%)
dim oSheet as object, oCell as Object
on error goto typeErr
' print vartype(vsheet)
select case varType(vSheet)
case is = 8
oSheet = thisComponent.sheets.getByName(vSheet)
case 2 to 5
'Wow! Calc has sheets with no name at index < 0,
' so NOT isNull(oSheet), if vSheet <= lbound(sheets) and CRASH!
if(vSheet <= thisComponent.sheets.count)AND(vSheet > 0) then
vSheet = cInt(vSheet)
oSheet = thisComponent.sheets.getByIndex(vSheet -1)
endif
end select
if isNull(oSheet) then
if(vSheet > thisComponent.sheets.count)OR(vSheet < 1) then
FNC_TYPE = "#SHEET"
else
FNC_TYPE = "#???"
endif
else
oCell = oSheet.getCellByPosition(iColIndex -1,lRowIndex -1)
FNC_TYPE = getMyCellType(oCell)
endif
exit function
typeErr:
if isNull(oCell) then
if (lRowIndex > oSheet.rows.count)OR(lRowIndex < 1) then
FNC_TYPE = "#ROW"
elseif (iColIndex > oSheet.columns.count)OR(iColIndex < 1) then
FNC_TYPE = "#COL"
else
FNC_TYPE = "#???"
endif
else
FNC_TYPE = "#FNC?"
endif
End Function
function isDateTimeFormat(oDoc,oCell) as Boolean
Dim lNF&,lNFType&
'detect a (userdefined) date-time format
lNF = oCell.NumberFormat
lNFType = oDoc.getNumberFormats.getByKey(lNF).Type
isDateTimeFormat = lNFType AND com.sun.star.util.NumberFormat.DATETIME
end function
function isBoolFormat(oDoc,oCell) as Boolean
Dim lNF&,lNFType&
'detect a (userdefined) boolean format
lNF = oCell.NumberFormat
lNFType = oDoc.getNumberFormats.getByKey(lNF).Type
isBoolFormat = lNFType AND com.sun.star.util.NumberFormat.LOGICAL
end function
Function getMyCellType(oCell,optional oDoc) As Integer
dim lContentType&,lResultType&,dValue#,sFmlLoc$,sText$
if isMissing(oDoc)then oDoc = ThisComponent
lContentType = oCell.getType
dValue = oCell.getValue
sFmlLoc = oCell.FormulaLocal
sText = oCell.getString
with com.sun.star.table.CellContentType
if oCell.Error > 0 then
' print oCell.FormulaResultType,"ERR"
'com.sun.star.sheet.FormulaResult.ERROR NEVER MATCHES
'A constant error-value (generated with paste special) pretends to be a string-formula!
getMyCellType = myErrorFlag
else
select case lContentType
case is = .FORMULA
lResultType = oCell.FormulaResultType
if lResultType = com.sun.star.sheet.FormulaResult.VALUE then
if isDateTimeFormat(oDoc,oCell) then
getMyCellType = myDateTimeFlag
elseif isDate(sText)then
getMyCellType = myDateTimeFlag
elseif isBoolFormat(oDoc,oCell)then
getMyCellType = myBoolFlag
else
getMyCellType = myNumberFlag
end if
' elseif lResultType = com.sun.star.sheet.FormulaResult.ERROR then
'NEVER MATCHES, returns number-formula instead
' getMyCellType = myFormulaFlag + myErrorFlag
else 'STRING
getMyCellType = myStringFlag
end if
case is = .VALUE
' print oCell.FormulaResultType,"VAL"
'a standard bool- or date-format is applied when the user enters a date/time true/false
'starbasic isDate() knows about localized date-strings
if isDate(sFmlLoc) then
getMyCellType = myDateTimeFlag
'but is does not know about localized "True" and "False" like german "Wahr" and "Falsch"
'I can't find an API-service, providing these strings
elseif isBoolFormat(oDoc,oCell)then
getMyCellType = myBoolFlag
end if
case is = .TEXT
' print oCell.FormulaResultType,"TXT"
getMyCellType = myStringFlag
case else '.BLANK
' print oCell.FormulaResultType,"BLANK"
getMyCellType = 0
end select
end if
end with
end Function |
Edit: I forgot to uncomment statement "on error goto typeErr". Now you get all "errors", (in fact they are strings  It's a type-testing function, returning wrong errors as string) |
|
