Module,Save As ProdGetLineNumber
'Copyright Stephen Lebans 1999
'May not be resold
'Please include my 1 line Copyright notice
'in your code if you use these functions
'I left a bunch of development code in here in case anyone decides to go
'down the same paths I did.
'Created by Stephen Lebans with help from Chris Bergmans
' Updated by Allen Browne Oct/2002
'Production version of GetLineNumberForm
'Works in Form or SubForm mode
'Set controlsource of unbound Text box to
'= RowNum([Form])
'Type exactly as above
Public Function RowNum(frm As Form) As Variant
On Error GoTo Err_RowNum
'Purpose: Numbering the rows on a form.
'Usage: Text box with ControlSource of: =RowNum([Form])
With frm.RecordsetClone
.Bookmark = frm.Bookmark
RowNum = .AbsolutePosition + 1
End With
Exit_RowNum:
Exit Function
Err_RowNum:
If Err.Number <> 3021& Then 'Ignore "No bookmark" at new row.
Debug.Print "RowNum() error " & Err.Number & " - " & Err.Description
End If
RowNum = Null
Resume Exit_RowNum
End Function
'********************************************
'Only USE GetLineNumberForm and Serialize
'********************************************
'Stephen Lebans with help from Chris Bergmans
' Updated by Allen
'Production version of GetLineNumberForm
'Works in Form or SubForm mode
'Set controlsource of unbound Text box to
'= GetLineNumberForm([Form])
'Type exactly as above
Function GetLineNumberForm(f As Form)
Dim rs As Recordset
Dim frmMain As Form
Dim frmCur As Form
Dim strName As String
Dim IsItSubForm As Boolean
Dim strFName As String
'is the form referenced in the parameter currently
'loaded as a SubForm?
'Check it parent property to find out.
On Error Resume Next
strFName = f.Parent.NAME
IsItSubForm = (Err = 0)
'Point to our error handler
On Error GoTo Err_GetLineNumber
If IsItSubForm Then
'its a SubForm
Set frmMain = f.Parent.Form
strName = f.NAME
Set frmCur = frmMain(strName).Form
Set rs = frmCur.RecordsetClone
Else
'It's not a SubForm
Set rs = f.RecordsetClone
Set frmCur = f
End If
' Find the current record.
rs.Bookmark = frmCur.Bookmark
GetLineNumberForm = rs.AbsolutePosition + 1
Bye_GetLineNumber:
Set rs = Nothing
Set frmMain = Nothing
Set frmCur = Nothing
Exit Function
Err_GetLineNumber:
Resume Bye_GetLineNumber
End Function
'Stephen Lebans April 1999
'For use directly as a calculated expression in the query
'For demonstration purposes only
'See my posting comp.databases.ms-accessfor an adapted version of this function
'to be used on a form in an unbound text box
www.Dejanews.com search Lebans query
'Blatantly adapted from Microsoft source code
'ACC: How to Display Line Numbers on Subform Records Article ID: Q120913
'Sorry, recordset property of Screen.ActiveDatasheet is not available
'In query design view save any changes to your query to disk before executing your query
'Only send an indexed field to the function
Function Serialize(qryname As String, keyname As String, keyvalue) As Long
Dim dbs As Database
Dim rs As Recordset
Set dbs = CurrentDb
On Error GoTo Err_Serialize
Set rs = dbs.OpenRecordset(qryname, dbOpenDynaset, dbReadOnly)
On Error GoTo Err_Serialize
'Find the current record.
Select Case rs.Fields(keyname).Type
' Find using numeric data type key value?
Case DB_INTEGER, DB_LONG, DB_CURRENCY, DB_SINGLE, _
DB_DOUBLE, DB_BYTE
rs.FindFirst "[" & keyname & "] = " & keyvalue
' Find using date data type key value?
Case DB_DATE
rs.FindFirst "[" & keyname & "] = #" & keyvalue & "#"
' Find using text data type key value?
Case DB_TEXT
rs.FindFirst "[" & keyname & "] = '" & keyvalue & "'"
Case Else
MsgBox "ERROR: Invalid key field data type!"
End Select
Serialize = Nz(rs.AbsolutePosition, 0) + 1
Err_Serialize:
'Add your own Error handler
rs.Close
dbs.Close
Set rs = Nothing
Set dbs = Nothing
End Function
Windows 7 64bit 
Access 2010 64bit
Reply With Quote
