Εμφάνιση ενός μόνο μηνύματος
  #6  
Παλιά 20-10-10, 23:27
Το avatar του χρήστη editolis
editolis Ο χρήστης editolis δεν είναι συνδεδεμένος
Super Moderator
Όνομα: Τολης
Έκδοση λογισμικού Office: Ms-Office 2007, Ms-Office 2013
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 02-01-2010
Περιοχή: ATHENS-GREECE
Μηνύματα: 180
Arrow

Θα χρειαστεις την εξης στηλη στο ερωτημα της φορμας σου:

RecNo: Fn_RecNoA("TO EROTIMA SOU";"ID";[ID])

Και τον εξης κωδικα για το Fn_RecNoA...

Κώδικας:
Function Fn_RecNoA(QueryName As String, _
                                    PrimKeyName As String, _
                                    PrimKeyVal As Variant) As Long
'       Returns the Record No for each Record in a Query
'       This is for use in a the Final Query
On Error Resume Next                    ' - (A)
    Dim rst As ADODB.Recordset, RCT As Long, CNT As Long
    Dim QNM As String, PKN As String, PKV As Variant
    
    QNM = QueryName
    PKN = PrimKeyName
    PKV = PrimKeyVal
    
    Set rst = New ADODB.Recordset
    Set rst.ActiveConnection = CurrentProject.Connection
    rst.CursorType = adOpenKeyset
    rst.CursorLocation = adUseClient
    rst.LockType = adLockOptimistic
    rst.Source = QNM
    
    rst.Open Options:=adCmdTable
    
    CNT = 0
    If rst.EOF And rst.BOF Then
        GoTo ExitPoint                ' If Recordset is empty
    End If    ' rst
    
' Populate The Recordset.
    With rst
        .MoveLast
        .MoveFirst
    End With
    RCT = rst.RecordCount
    
    CNT = 1
    rst.MoveFirst
    Do While CNT <= RCT
        If rst.EOF Or rst.Fields(PKN) = PKV Then
            Exit Do
        End If       ' FDV
        rst.MoveNext
        CNT = CNT + 1
    Loop

ExitPoint:
    rst.Close
    Set rst = Nothing
    Fn_RecNoA = CNT
    On Error GoTo 0
End Function
Απάντηση με παράθεση