OpenOffice.org Forum at OOoForum.orgThe OpenOffice.org Forum
 
 [Home]   [FAQ]   [Search]   [Memberlist]   [Usergroups]   [Register
 [Profile]   [Log in to check your private messages]   [Log in

[Calc] Cell-properties as function-results

 
Post new topic   Reply to topic    OOoForum.org Forum Index -> OpenOffice.org Code Snippets
View previous topic :: View next topic  
Author Message
Villeroy
Super User
Super User


Joined: 04 Oct 2004
Posts: 10106
Location: Germany

PostPosted: Mon Mar 06, 2006 11:34 am    Post subject: [Calc] Cell-properties as function-results Reply with quote

The following cell-funtions return properties of cells as formula-results.
Normally a userdefined cell function takes a value (string or number) of a passed cell-reference rather than a cell-object.
All these functions call a helper-function getSheetCell(vSheet,rowindex,colindex) in order to retrieve a cell-object. Then they examine some property the cell and return the resulting value as text or number.
Referencing a cell-object
First param can be a sheet-name or a sheet-index starting at 1 like builtin SHEET()
Second param is a row-index starting at 1 like builtin ROW()
Third param is a column-index starting at 1 like builtin COLUMN()
Some examples of absolute/relative referencing returning the style name of referred cell:
=CELL_STYLE(1;1;1) equivalent to <1st_sheet>.$A$1
=CELL_STYLE("mySheet";1;1) equivalent to $mySheet.$A$1
=CELL_STYLE(SHEET();1;1) equivalent to $A$1. SHEET() returnes this sheet's index
=CELL_STYLE(SHEET()+1;1;1) equivalent to <next_Sheet>$A$1. SHEET()+1 returnes next sheet's index
=CELL_STYLE(SHEET();ROW(A1);COLUMN(A1) equivalent to relative A1.
=CELL_STYLE(SHEET();1;COLUMN(A1) equivalent to mixed A$1.
=CELL_STYLE(SHEET();ROW(A1);6) equivalent to mixed $F1.
=CELL_STYLE(SHEET();ROW();6) --> This row, column F.
=CELL_STYLE(SHEET();ROW();COLUMN()) --> examines the cell itself

All functions return NULL in case of parameter out of bounds (eg. sheet/row/col < 1) which gives #VALUE as formula-result.
EDIT 2006-04-01:
Added CELL_VALUE(), allowing to get a cell-value from another sheet, using the index of that sheet.
EDIT 2006-05-24:
Added CELL_FORMULA(), translating a localized formula to english. After reorganizing my OOo-Basic stuff I learned that sheet functions stop working when moved to some other library than "Standard".
EDIT 2006-05-30:
Some debugging and added CELL_URL() which extracts the url from a hyperlink of given cell. Optional parameter allows to extraction of an URL from another one than the first hyperlink (default=1 for first hyperlink).
EDIT 2006-06-16: Added CELL_LOCKED
EDIT 2006-06-29: Added CELL_VISIBLE
EDIT 2006-11-17: Added CELL_COLOR and array-function SHEETLIST(). The latter is not related to the others since it does not inspect cells, but it may be usefull anyway.
Added gimmick CELL_WORDCOUNT() based on function hotcount by accabrown.
EDIT 2006-12-30: Added CELL_NOTE
Code:

REM  *****  BASIC  *****
Function CELL_NOTE(vSheet,lRowIndex&,iColIndex%)
Dim v
   v = getSheetCell(vSheet,lRowIndex&,iColIndex%)
   if vartype(v) = 9 then
      CELL_NOTE = v.Annotation.getText.getString
   else
      CELL_NOTE = v
   endif
End Function
Function CELL_WORDCOUNT(vSheet,lRowIndex&,iColIndex%)
Dim v
   v = getSheetCell(vSheet,lRowIndex&,iColIndex%)
   if vartype(v) = 9 then
      CELL_WORDCOUNT = hotcount(v)
   else
      CELL_WORDCOUNT = v
   endif
End Function
REM an array function, useful for indirect addressing of sheets by position
REM returns a horizontal array of all sheet-names(vertical {=TRANSPOSE(SHEETLIST())}
REM Name of first sheet =INDEX(SHEETLIST();1;1). Row-index is always 1.
Function SHEETLIST()
   SHEETLIST = thisComponent.getSheets.getElementNames()
End Function
Function CELL_COLOR(vSheet,lRowIndex&,iColIndex%)
Dim v
   v = getSheetCell(vSheet,lRowIndex&,iColIndex%)
   if vartype(v) = 9 then
      CELL_COLOR = v.CellBackColor
   else
      CELL_COLOR = v
   endif
End Function
Function CELL_VISIBLE(vSheet,lRowIndex&,iColIndex%)
Dim v
   v = getSheetCell(vSheet,lRowIndex&,iColIndex%)
   if vartype(v) = 9 then
      CELL_VISIBLE = Abs(v.Rows.isVisible)
   else
      CELL_VISIBLE = v
   endif
End Function
Function CELL_LOCKED(vSheet,lRowIndex&,iColIndex%)as integer
Dim v
   v = getSheetCell(vSheet,lRowIndex&,iColIndex%)
   if vartype(v) = 9 then
      CELL_LOCKED = Abs(v.CellProtection.isLocked)
   else
      CELL_LOCKED = v
   endif
End Function
REM get URL of N th text-hyperlink from a cell, default N=1)
Function CELL_URL(vSheet,lRowIndex&,iColIndex%,optional n%)
Dim v
   If isMissing(n) then n = 1
   If n < 1 then
      REM prints #VALUE to the cell:
      CELL_URL = Null
      exit function
   End If
   v = getSheetCell(vSheet,lRowIndex&,iColIndex%)
   if vartype(v) = 9 then
      if v.Textfields.Count >= n  then
         CELL_URL = v.getTextfields.getByIndex(n-1).URL
      else
         Cell_URL = ""
      endif
   else
      CELL_URL = v
   endif
End Function
REM get unlocalized (english) formula
Function CELL_FORMULA(vSheet,lRowIndex&,iColIndex%)
Dim v
   v = getSheetCell(vSheet,lRowIndex&,iColIndex%)
   if vartype(v) = 9 then
      CELL_FORMULA = v.getFormula()
   else
      CELL_FORMULA = v
   endif
End Function
'Split by line breaks
'=CELL_PARA(SHEET(),1,1,2) -> second paragraph of A1 in this sheet
Function CELL_PARA(vSheet,lRowIndex&,iColIndex%,optional n)
Dim v,s$,a(),i%
   v = getSheetCell(vSheet,lRowIndex&,iColIndex%)
   if vartype(v) = 9 then
      s = v.getString
      if not isMissing(n) then i = cInt(n)
      if i > 0 then
         a() = Split(s,chr(10))
         If (i <= uBound(a())+1)then
            CELL_PARA = a(i -1)
         else
            CELL_PARA = NULL
         endif
      else
         CELL_PARA = s
      endif
   else
      CELL_PARA = v
   endif
end Function
REM get value of a cell by it's position in workbook
REM this is useful if you want to get a cell-value from another sheet by the sheet's position
Function CELL_VALUE(vSheet,lRowIndex&,iColIndex%)
Dim v
   v = getSheetCell(vSheet,lRowIndex&,iColIndex%)
   if vartype(v) = 9 then
      CELL_VALUE = getCellValue(v)
   else
      CELL_VALUE = v
   endif
End Function
'return localized name of cell-style
Function CELL_STYLE(vSheet,lRowIndex&,iColIndex%)
Dim v,sDN$
   v = getSheetCell(vSheet,lRowIndex&,iColIndex%)
   if vartype(v) = 9 then
      sDN = thisComponent.StyleFamilies("CellStyles").getByName(v.CellStyle).DisplayName
      CELL_STYLE = sDN
   else
      CELL_STYLE = v
   endif
End Function
'return a com.sun.star.table.CellContentType
Function CELL_getType(vSheet,lRowIndex&,iColIndex%)
Dim v
   v = getSheetCell(vSheet,lRowIndex&,iColIndex%)
   if vartype(v) = 9 then
      CELL_getType = v.getType
   else
      CELL_getType = v
   endif
End Function
'returns a com.sun.star.sheet.CellFlags
Function CELL_FormulaResultType(vSheet,lRowIndex&,iColIndex%)
Dim v
   v = getSheetCell(vSheet,lRowIndex&,iColIndex%)
   if vartype(v) = 9 then
      CELL_FormulaResultType = v.FormulaResultType
   else
      CELL_FormulaResultType = v
   endif
End Function
'return the numberformat-index
Function CELL_NumberFormat(vSheet,lRowIndex&,iColIndex%)
Dim v
   v = getSheetCell(vSheet,lRowIndex&,iColIndex%)
   if vartype(v) = 9 then
      CELL_NumberFormat = v.NumberFormat
   else
      CELL_NumberFormat = v
   endif
End Function
'return a com.sun.star.util.NumberFormat
Function CELL_NumberFormatType(vSheet,lRowIndex&,iColIndex%)
Dim v,lNF&
   v = getSheetCell(vSheet,lRowIndex&,iColIndex%)
   if vartype(v) = 9 then
      lNF = v.NumberFormat
      CELL_NumberFormatType = ThisComponent.getNumberFormats.getByKey(lNF).Type
   else
      CELL_NumberFormatType = v
   endif
End Function
'return a char-locale
Function CELL_Locale(vSheet,lRowIndex&,iColIndex%)
DIm v
   v = getSheetCell(vSheet,lRowIndex&,iColIndex%)
   if vartype(v) = 9 then
      CELL_Locale = getCharLocaleStringFromObj(v)
   else
      CELL_Locale = v
   endif
End Function
Function DOC_Locale()
   DOC_Locale = getCharLocaleStringFromObj(ThisComponent)
End Function
'Because most languages do not know variants, there is no simple "Cell.getValue"
Function getCellValue(oCell as com.sun.star.sheet.Cell) as variant
dim lContentType&,lResultType&,oDummy as Object
lContentType = oCell.getType
lResultType = oCell.FormulaResultType
If oCell.getError <> 0 then
   'return Null which gives err #VALUE when passed back to a sheet-cell
   getCellValue = oDummy
else
   with com.sun.star.table.CellContentType
   select case lContentType
      case is = .FORMULA
      If lResultType = com.sun.star.sheet.FormulaResult.VALUE then
         getCellValue = oCell.getValue '
      else lResultType = com.sun.star.sheet.FormulaResult.STRING
         getCellValue = oCell.getString
      'no way_ http://www.openoffice.org/issues/show_bug.cgi?id=58749
      'elseIf lResultType = com.sun.star.sheet.ERROR then
      '   getCellValue = oCell.getError
      end if
   case is = .VALUE
      getCellValue = oCell.getValue
   case is = .TEXT
      getCellValue = oCell.getString
   case is = .EMPTY
   'default variant empty
   end select
   end with
end if
end function
REM Helpers for above sheet functions. Get cell from sheet's name or
REM position; cell's row-position; cell's col-position
Function getSheetCell(byVal vSheet,byVal lRowIndex&,byVal iColIndex%)
dim oSheet
'   print vartype(vsheet)
   oSheet = getSheet(vSheet)
   if isNull(oSheet) then
      getSheetCell = NULL
   elseif (lRowIndex > oSheet.rows.count)OR(lRowIndex < 1) then
      getSheetCell = NULL
   elseif (iColIndex > oSheet.columns.count)OR(iColIndex < 1) then
      getSheetCell = NULL
   else
      getSheetCell = oSheet.getCellByPosition(iColIndex -1,lRowIndex -1)
   endif
End Function
Function getSheet(byVal vSheet)
on error goto exitErr
   select case varType(vSheet)
   case is = 8
      if thisComponent.sheets.hasbyName(vSheet) then
         getSheet = thisComponent.sheets.getByName(vSheet)
      else
         getSheet = NULL
      endif
   case 2 to 5
      vSheet = cInt(vSheet)
      'Wow! Calc has sheets with no name at index < 0,
      ' so NOT isNull(oSheet), if vSheet <= lbound(sheets) and CRASH!
      'http://www.openoffice.org/issues/show_bug.cgi?id=58796
      if(vSheet <= thisComponent.sheets.count)AND(vSheet > 0) then
         getSheet = thisComponent.sheets.getByIndex(vSheet -1)
      else
         getSheet = NULL
      endif
   end select
exit function
exitErr:
getSheet = NULL
End Function
Function getCharLocaleStringFromObj(oObj) as String
Dim s$
   with oObj.CharLocale
      s = .Language
      s = s &"_"& .Country
      if .Variant <>"" then s = s &"_"& .Variant
   End With
   getCharLocaleStringFromObj = s
End Function

'stolen from http://www.oooforum.org/forum/viewtopic.phtml?t=13214
' and modified so it takes a cell as parameter and gets the locale from the char-locale of that cell
function hotcount(oCell)
' the ultimate, using the same breakiterator as the program
dim aString$
dim mystartpos as long
dim numwords%,nw%
dim nextwd as new com.sun.star.i18n.Boundary
dim aLocale as new com.sun.star.lang.Locale
aString = oCell.getString
aLocale = oCell.CharLocale
numwords=1 ' don't ask me why we need this
mystartpos=0
brk=createUnoService("com.sun.star.i18n.BreakIterator")
nextwd=brk.nextWord(aString,startpos,aLocale,com.sun.star.i18n.WordType.WORD_COUNT)
Do while nextwd.startPos <> nextwd.endPos
   numwords=numwords+1
   nw=nextwd.startPos
   nextwd=brk.nextWord(aString,nw,aLocale,com.sun.star.i18n.WordType.WORD_COUNT)
Loop
hotcount=numwords
end Function


Last edited by Villeroy on Thu Jan 15, 2009 5:23 am; edited 1 time in total
Back to top
View user's profile Send private message
hedgehog2008
Newbie
Newbie


Joined: 12 Apr 2008
Posts: 3

PostPosted: Sat Apr 12, 2008 12:50 am    Post subject: Reply with quote

Sorry for my ignorance, I need to build a sheet in which to add, from a long product list, only the items (lines) which have a figure in the quantity column. I thought that a function like "adding only visible cells" after selecting them through autofilter is the solution, that's why I searched the forum and then found your thread.

1. I saw the thread is quite old, no good news within OOo since then?
2. Anyhow, not being a programmer, don't I have some easier way to access the CELL_VISIBLE() function or something similar?

Thank you !!!!!
Back to top
View user's profile Send private message
Villeroy
Super User
Super User


Joined: 04 Oct 2004
Posts: 10106
Location: Germany

PostPosted: Sat Apr 12, 2008 12:58 am    Post subject: Reply with quote

You want built-in function SUBTOTAL. See online help.
_________________
Rest in peace, oooforum.org
Get help on https://forum.openoffice.org
Back to top
View user's profile Send private message
hedgehog2008
Newbie
Newbie


Joined: 12 Apr 2008
Posts: 3

PostPosted: Sat Apr 12, 2008 2:17 am    Post subject: Reply with quote

EXCELLENT !

It took some time, until I made all the tests. IT WORKS !!

The only thing to care of is to mark all the cells you want to be correlated within the autofilter, before selecting the option from the menu.
I tried first applying autofilter to only one column (and that, only partial), but not worked.

Thank you vvvv much and nice weekend. I thought i am the only working at this time...Smile))) At home, of course.
Back to top
View user's profile Send private message
Villeroy
Super User
Super User


Joined: 04 Oct 2004
Posts: 10106
Location: Germany

PostPosted: Sat Apr 12, 2008 2:36 am    Post subject: Reply with quote

Best wishes and a nice weekend too, hedgehog2008. Yesterday evening I saw a hedgehog. Funny animals, always busy in a straightforward cool manner.
_________________
Rest in peace, oooforum.org
Get help on https://forum.openoffice.org
Back to top
View user's profile Send private message
hedgehog2008
Newbie
Newbie


Joined: 12 Apr 2008
Posts: 3

PostPosted: Sat Apr 12, 2008 2:55 am    Post subject: Reply with quote

Sorry, I forgot to upload my avatar !!!! Smile)))
Back to top
View user's profile Send private message
Daviswilson
Newbie
Newbie


Joined: 10 Sep 2008
Posts: 1

PostPosted: Wed Sep 10, 2008 8:04 am    Post subject: hi Reply with quote

hi to all the members of this forum.The code is really excellent.It took for me to understand but at the end the output is excellent.It is fine.Thanks for posting Villeroy.Best wishes for you.
-------------------------------------------------------
Davis.

Foreclosed Homes
Back to top
View user's profile Send private message
123Master
Newbie
Newbie


Joined: 15 Jan 2009
Posts: 2

PostPosted: Fri Jan 16, 2009 2:55 pm    Post subject: Outstanding Reply with quote

I get "Inadmissible value or data type." for =CELL_STYLE(1;1;1) in OO 2.4.1 on Ubuntu.

Fortunately, the one I really wanted, CELL_VISIBLE works just fine. I sure wish I could pass a cell by reference, rather than sheet, row, column. =CELL_VISIBLE(SHEET(A1);ROW(A1);COLUMN(A1)) works, but when making a custom formula, I would write it as =CELL_VISIBLE('MyOptionalSheetName'.A1) if I could. Would I have to parse the sheet name, letters, and numbers inside the macro and convert them to numbers, or can functions handle a normal cell reference?
Back to top
View user's profile Send private message
Villeroy
Super User
Super User


Joined: 04 Oct 2004
Posts: 10106
Location: Germany

PostPosted: Fri Jan 16, 2009 3:12 pm    Post subject: Re: Outstanding Reply with quote

123Master wrote:
I get "Inadmissible value or data type." for =CELL_STYLE(1;1;1) in OO 2.4.1 on Ubuntu.

Fortunately, the one I really wanted, CELL_VISIBLE works just fine. I sure wish I could pass a cell by reference, rather than sheet, row, column. =CELL_VISIBLE(SHEET(A1);ROW(A1);COLUMN(A1)) works, but when making a custom formula, I would write it as =CELL_VISIBLE('MyOptionalSheetName'.A1) if I could. Would I have to parse the sheet name, letters, and numbers inside the macro and convert them to numbers, or can functions handle a normal cell reference?

myself wrote:

Normally a userdefined cell function takes a value (string or number) of a passed cell-reference rather than a cell-object.

See code of BAS_INDIRECT which partially fixed the incomplete INDIRECT of versions <2.3: http://www.oooforum.org/forum/viewtopic.phtml?t=61265

The functions of this thread may be used to repair broken or badly designed spreadsheets where information is hidden in hyperlink-fields, formattings, notes and other attributes. Extract the desired information int cells, convert formula results to values (paste special) and redesign the spreadsheet, so you can apply attributes by cell values rather than the other way round. (e.g. filters and conditional formatting)
These functions require hard recalculation [Ctrl+Shift+F9] since they can not update properly. When they first calculate while loading the file there is no "ThisComponent", so they show #VALUE first,...
Please, do not treat these functions as regular functions for daily use.
_________________
Rest in peace, oooforum.org
Get help on https://forum.openoffice.org
Back to top
View user's profile Send private message
127.0.0.1
Newbie
Newbie


Joined: 16 Jan 2009
Posts: 1

PostPosted: Fri Jan 16, 2009 8:51 pm    Post subject: A million thanks Reply with quote

Villeroy,

A million thanks for providing that code. A lot of useful functions there. I wanted it for the cell_url() function, but I'm sure I'll find a use for several more.

Thanks!
Back to top
View user's profile Send private message
IamTrying
Newbie
Newbie


Joined: 15 Jan 2012
Posts: 1

PostPosted: Sun Jan 15, 2012 8:06 am    Post subject: Reply with quote

This works. Just for record here is the details:

1) Go to the file
2) Clilck > tools > macros > organize macros > libreoffice basic > Dialog box open >
On left Module1 is selected > Press Edit

3) Paste this code > save it etc

Code:
REM  *****  BASIC  *****
Function CELL_NOTE(vSheet,lRowIndex&,iColIndex%)
Dim v
   v = getSheetCell(vSheet,lRowIndex&,iColIndex%)
   if vartype(v) = 9 then
      CELL_NOTE = v.Annotation.getText.getString
   else
      CELL_NOTE = v
   endif
End Function
Function CELL_WORDCOUNT(vSheet,lRowIndex&,iColIndex%)
Dim v
   v = getSheetCell(vSheet,lRowIndex&,iColIndex%)
   if vartype(v) = 9 then
      CELL_WORDCOUNT = hotcount(v)
   else
      CELL_WORDCOUNT = v
   endif
End Function
REM an array function, useful for indirect addressing of sheets by position
REM returns a horizontal array of all sheet-names(vertical {=TRANSPOSE(SHEETLIST())}
REM Name of first sheet =INDEX(SHEETLIST();1;1). Row-index is always 1.
Function SHEETLIST()
   SHEETLIST = thisComponent.getSheets.getElementNames()
End Function
Function CELL_COLOR(vSheet,lRowIndex&,iColIndex%)
Dim v
   v = getSheetCell(vSheet,lRowIndex&,iColIndex%)
   if vartype(v) = 9 then
      CELL_COLOR = v.CellBackColor
   else
      CELL_COLOR = v
   endif
End Function
Function CELL_VISIBLE(vSheet,lRowIndex&,iColIndex%)
Dim v
   v = getSheetCell(vSheet,lRowIndex&,iColIndex%)
   if vartype(v) = 9 then
      CELL_VISIBLE = Abs(v.Rows.isVisible)
   else
      CELL_VISIBLE = v
   endif
End Function
Function CELL_LOCKED(vSheet,lRowIndex&,iColIndex%)as integer
Dim v
   v = getSheetCell(vSheet,lRowIndex&,iColIndex%)
   if vartype(v) = 9 then
      CELL_LOCKED = Abs(v.CellProtection.isLocked)
   else
      CELL_LOCKED = v
   endif
End Function
REM get URL of N th text-hyperlink from a cell, default N=1)
Function CELL_URL(vSheet,lRowIndex&,iColIndex%,optional n%)
Dim v
   If isMissing(n) then n = 1
   If n < 1 then
      REM prints #VALUE to the cell:
      CELL_URL = Null
      exit function
   End If
   v = getSheetCell(vSheet,lRowIndex&,iColIndex%)
   if vartype(v) = 9 then
      if v.Textfields.Count >= n  then
         CELL_URL = v.getTextfields.getByIndex(n-1).URL
      else
         Cell_URL = ""
      endif
   else
      CELL_URL = v
   endif
End Function
REM get unlocalized (english) formula
Function CELL_FORMULA(vSheet,lRowIndex&,iColIndex%)
Dim v
   v = getSheetCell(vSheet,lRowIndex&,iColIndex%)
   if vartype(v) = 9 then
      CELL_FORMULA = v.getFormula()
   else
      CELL_FORMULA = v
   endif
End Function
'Split by line breaks
'=CELL_PARA(SHEET(),1,1,2) -> second paragraph of A1 in this sheet
Function CELL_PARA(vSheet,lRowIndex&,iColIndex%,optional n)
Dim v,s$,a(),i%
   v = getSheetCell(vSheet,lRowIndex&,iColIndex%)
   if vartype(v) = 9 then
      s = v.getString
      if not isMissing(n) then i = cInt(n)
      if i > 0 then
         a() = Split(s,chr(10))
         If (i <= uBound(a())+1)then
            CELL_PARA = a(i -1)
         else
            CELL_PARA = NULL
         endif
      else
         CELL_PARA = s
      endif
   else
      CELL_PARA = v
   endif
end Function
REM get value of a cell by it's position in workbook
REM this is useful if you want to get a cell-value from another sheet by the sheet's position
Function CELL_VALUE(vSheet,lRowIndex&,iColIndex%)
Dim v
   v = getSheetCell(vSheet,lRowIndex&,iColIndex%)
   if vartype(v) = 9 then
      CELL_VALUE = getCellValue(v)
   else
      CELL_VALUE = v
   endif
End Function
'return localized name of cell-style
Function CELL_STYLE(vSheet,lRowIndex&,iColIndex%)
Dim v,sDN$
   v = getSheetCell(vSheet,lRowIndex&,iColIndex%)
   if vartype(v) = 9 then
      sDN = thisComponent.StyleFamilies("CellStyles").getByName(v.CellStyle).DisplayName
      CELL_STYLE = sDN
   else
      CELL_STYLE = v
   endif
End Function
'return a com.sun.star.table.CellContentType
Function CELL_getType(vSheet,lRowIndex&,iColIndex%)
Dim v
   v = getSheetCell(vSheet,lRowIndex&,iColIndex%)
   if vartype(v) = 9 then
      CELL_getType = v.getType
   else
      CELL_getType = v
   endif
End Function
'returns a com.sun.star.sheet.CellFlags
Function CELL_FormulaResultType(vSheet,lRowIndex&,iColIndex%)
Dim v
   v = getSheetCell(vSheet,lRowIndex&,iColIndex%)
   if vartype(v) = 9 then
      CELL_FormulaResultType = v.FormulaResultType
   else
      CELL_FormulaResultType = v
   endif
End Function
'return the numberformat-index
Function CELL_NumberFormat(vSheet,lRowIndex&,iColIndex%)
Dim v
   v = getSheetCell(vSheet,lRowIndex&,iColIndex%)
   if vartype(v) = 9 then
      CELL_NumberFormat = v.NumberFormat
   else
      CELL_NumberFormat = v
   endif
End Function
'return a com.sun.star.util.NumberFormat
Function CELL_NumberFormatType(vSheet,lRowIndex&,iColIndex%)
Dim v,lNF&
   v = getSheetCell(vSheet,lRowIndex&,iColIndex%)
   if vartype(v) = 9 then
      lNF = v.NumberFormat
      CELL_NumberFormatType = ThisComponent.getNumberFormats.getByKey(lNF).Type
   else
      CELL_NumberFormatType = v
   endif
End Function
'return a char-locale
Function CELL_Locale(vSheet,lRowIndex&,iColIndex%)
DIm v
   v = getSheetCell(vSheet,lRowIndex&,iColIndex%)
   if vartype(v) = 9 then
      CELL_Locale = getCharLocaleStringFromObj(v)
   else
      CELL_Locale = v
   endif
End Function
Function DOC_Locale()
   DOC_Locale = getCharLocaleStringFromObj(ThisComponent)
End Function
'Because most languages do not know variants, there is no simple "Cell.getValue"
Function getCellValue(oCell as com.sun.star.sheet.Cell) as variant
dim lContentType&,lResultType&,oDummy as Object
lContentType = oCell.getType
lResultType = oCell.FormulaResultType
If oCell.getError <> 0 then
   'return Null which gives err #VALUE when passed back to a sheet-cell
   getCellValue = oDummy
else
   with com.sun.star.table.CellContentType
   select case lContentType
      case is = .FORMULA
      If lResultType = com.sun.star.sheet.FormulaResult.VALUE then
         getCellValue = oCell.getValue '
      else lResultType = com.sun.star.sheet.FormulaResult.STRING
         getCellValue = oCell.getString
      'no way_ http://www.openoffice.org/issues/show_bug.cgi?id=58749
      'elseIf lResultType = com.sun.star.sheet.ERROR then
      '   getCellValue = oCell.getError
      end if
   case is = .VALUE
      getCellValue = oCell.getValue
   case is = .TEXT
      getCellValue = oCell.getString
   case is = .EMPTY
   'default variant empty
   end select
   end with
end if
end function
REM Helpers for above sheet functions. Get cell from sheet's name or
REM position; cell's row-position; cell's col-position
Function getSheetCell(byVal vSheet,byVal lRowIndex&,byVal iColIndex%)
dim oSheet
'   print vartype(vsheet)
   oSheet = getSheet(vSheet)
   if isNull(oSheet) then
      getSheetCell = NULL
   elseif (lRowIndex > oSheet.rows.count)OR(lRowIndex < 1) then
      getSheetCell = NULL
   elseif (iColIndex > oSheet.columns.count)OR(iColIndex < 1) then
      getSheetCell = NULL
   else
      getSheetCell = oSheet.getCellByPosition(iColIndex -1,lRowIndex -1)
   endif
End Function
Function getSheet(byVal vSheet)
on error goto exitErr
   select case varType(vSheet)
   case is = 8
      if thisComponent.sheets.hasbyName(vSheet) then
         getSheet = thisComponent.sheets.getByName(vSheet)
      else
         getSheet = NULL
      endif
   case 2 to 5
      vSheet = cInt(vSheet)
      'Wow! Calc has sheets with no name at index < 0,
      ' so NOT isNull(oSheet), if vSheet <= lbound(sheets) and CRASH!
      'http://www.openoffice.org/issues/show_bug.cgi?id=58796
      if(vSheet <= thisComponent.sheets.count)AND(vSheet > 0) then
         getSheet = thisComponent.sheets.getByIndex(vSheet -1)
      else
         getSheet = NULL
      endif
   end select
exit function
exitErr:
getSheet = NULL
End Function
Function getCharLocaleStringFromObj(oObj) as String
Dim s$
   with oObj.CharLocale
      s = .Language
      s = s &"_"& .Country
      if .Variant <>"" then s = s &"_"& .Variant
   End With
   getCharLocaleStringFromObj = s
End Function

'stolen from http://www.oooforum.org/forum/viewtopic.phtml?t=13214
' and modified so it takes a cell as parameter and gets the locale from the char-locale of that cell
function hotcount(oCell)
' the ultimate, using the same breakiterator as the program
dim aString$
dim mystartpos as long
dim numwords%,nw%
dim nextwd as new com.sun.star.i18n.Boundary
dim aLocale as new com.sun.star.lang.Locale
aString = oCell.getString
aLocale = oCell.CharLocale
numwords=1 ' don't ask me why we need this
mystartpos=0
brk=createUnoService("com.sun.star.i18n.BreakIterator")
nextwd=brk.nextWord(aString,startpos,aLocale,com.sun.star.i18n.WordType.WORD_COUNT)
Do while nextwd.startPos <> nextwd.endPos
   numwords=numwords+1
   nw=nextwd.startPos
   nextwd=brk.nextWord(aString,nw,aLocale,com.sun.star.i18n.WordType.WORD_COUNT)
Loop
hotcount=numwords
end Function

Sub Macro1

End Sub


4) Now go the the file where you need to extract URL from the column > select an empty column > put this and > hit enter
=CELL_URL("Sheet1",ROW(),COLUMN()-3)

Note: CELL_URL is the method
parameter 1 = your current sheet you want to search for
parameter 2 = your current row (if you have 5000 rows just drag this formula and it will do row by row)
parameter 3 = your current column, the new empty one (juts drag it will apply that forumula)

5) You get hyperlink/url now with this


Thanks!!
Back to top
View user's profile Send private message
singham2
Newbie
Newbie


Joined: 14 Apr 2012
Posts: 1

PostPosted: Sat Apr 14, 2012 3:47 am    Post subject: Reply with quote

Thanks You
Back to top
View user's profile Send private message
bertram
Power User
Power User


Joined: 13 Nov 2005
Posts: 55

PostPosted: Tue Mar 19, 2013 7:10 pm    Post subject: [solved] Reply with quote

solved ... I had defined folumla cell D3 as text ... whoops

===
trying to extract urls

open office 2.4 in windows 98se

cell C3 contains a url
cell D3 has =cell_url(sheet();row(c3);column(c3))

it doesn't take ...
lowercase doesn't convert to uppercase ...

code was cut and pasted into
Tools > Macros > Organize Macros > OpenOfficeOrg Basic
My Macros
> Standard (library?)
> > IntrospectiveCellFunctions (module?)

Tools > Otpions > OpenOffice.org > Security > Macro security > Low (not recommended)

it must be something that I did because it used to work ?? Memory is going and I can't remember how to fix ...


Last edited by bertram on Fri May 17, 2013 5:32 am; edited 1 time in total
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    OOoForum.org Forum Index -> OpenOffice.org Code Snippets All times are GMT - 8 Hours
Page 1 of 1

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum


Powered by phpBB © 2001, 2005 phpBB Group