View Single Post
  #8   Report Post  
 
Posts: n/a
Default

I've a workbook containing this function. Download my
Excel_Calendar.xls from:
http://www.pvv.org/~nsaa/excel.html#21

I've named it ShowFormula:
=ShowFormula(A1)

In the same manner I've made a function showing the note in a Cell
=NoteShow(A1)

The Functions
Public Function ShowFormula(ByRef rngCell As Range) As String
'************************************************* *****************************
'
' Macro ShowFormula created 2004-08-13 by Nikolai Sandved
)
'
' Description: This Function returns the Formula in the input Cell
rngCell as
' text
'
' Input:
' rngCell - A cell
'
' Output
' RankStatistical - Formula in the input Cell rngCell as text
'
'************************************************* *****************************

'** Error Control
On Error GoTo ErrorHandle

ShowFormula = rngCell.Formula

Exit Function

ErrorHandle:
'** Set the return error objects
MsgBox ("Error code:" & CStr(Err) & Chr(13) & Chr(13) _
& "Further Description: " & Error$ & Chr(13) _
& "In Custom function ShowFormula")
End Function


Public Function NoteShow(ByRef rngCell As Range) As String
'************************************************* *****************************
'
' Macro NoteShow created 2004-06-21 by Nikolai Sandved )
'
' Description: This Function returns the Note in the input Cell rngCell
'
' Input:
' rngCell - A cell Range
'
' Output
' ShowNote - Returns the Note as text from the Cell reference given
'
'************************************************* *****************************

'** Error Control
On Error GoTo ErrorHandle

'** Define variables
Dim wbm As Workbook 'The active workbook
Dim wsWithNote As Worksheet 'The worksheet with the Note
Dim strWorkbookName As String 'The Workbook with the Note

'** Declare variables
strWorkbookName = Mid(rngCell.Address(1, 1, 1, 1), _
InStr(rngCell.Address(1, 1, 1, 1), "[") + 1, _
InStrRev(rngCell.Address(1, 1, 1, 1), "]") - _
InStr(rngCell.Address(1, 1, 1, 1), "[") - 1)
Set wbm = Workbooks(strWorkbookName)
Set wsWithNote = wbm.Sheets(rngCell.Worksheet.Name)

NoteShow =
Application.WorksheetFunction.Clean(wsWithNote.Ran ge(rngCell.Address).NoteText)

'Cleans
Set wsWithNote = Nothing
Set wbm = Nothing

Exit Function

ErrorHandle:
'** Set the return error objects
MsgBox ("Error code:" & CStr(Err) & Chr(13) & Chr(13) _
& "Further Description: " & Error$ & Chr(13) _
& "In Custom function NoteShow")

'Cleans
Set wsWithNote = Nothing
Set wbm = Nothing

End Function