SQL SERVER Recordset ADO

Signaler
Messages postés
36
Date d'inscription
mardi 3 août 2004
Statut
Membre
Dernière intervention
9 novembre 2007
-
Messages postés
36
Date d'inscription
mardi 3 août 2004
Statut
Membre
Dernière intervention
9 novembre 2007
-
Salut à tous,

Bonjour à tous,

Est-ce que quelqu'un sait pourquoi la propriété "Absolute Position "de mon recordset marque       (-1) ?

Exemple :

msgbox (rsRegistre.AbsolutePosition )

donne systématiquement le résultat (-1) sauf lorsqu'on va au dernier enregistrement où cela donne :   (-3) !!

Est-ce que cette propriété ne fonctionne pas avec une base SQL server?

J'utilise ADO par code.

Dans le code ci-joint, le problème apparaît au niveau de la sub UpdateButtons().

@+

Lap2

Option Explicit
Dim p_strServeur As String
Dim p_strBase As String
Dim l_strconnectstring As String
Dim MaConnexion As New Connection
Dim SQL As String
Dim SQLProd As String
Dim SQLPrestation As String
Dim SQLDechet As String
Dim SQLTraitement As String
Dim SQLPrestataire As String
Dim bndRegistre As BindingCollection
Dim rsRegistre As New ADODB.Recordset
Dim rsProducteur As New ADODB.Recordset
Dim rsPrestation As New ADODB.Recordset
Dim rsDechet As New ADODB.Recordset
Dim rsTraitement As New ADODB.Recordset
Dim rsPrestataire As New ADODB.Recordset
Dim lgRegistreCount As Long
Dim lgRegistreAbsPos As Long
Dim strStatusBar_One As Variant




Public Function OuvreConnection(p_strServeur As String, p_strBase As String) As Boolean
'Nom Fonction   : OuvreConnection
'Description    : Ouvre une connection ADO sur base SQL Server
p_strServeur = "HOG7RI7ZD24PTIT\SQLEXPRESS"
p_strBase = "GestDechMarkIV"


On Error GoTo erreur
'                                                    nom du serveur              nom de la base
' uid= nom de l'utilisateur
' pwd=mot de passe
l_strconnectstring = "uid=;pwd=;driver={SQL Server}; server=" & p_strServeur & ";database=" & p_strBase & ";dsn=''"
If MaConnexion.State = adStateOpen Then MaConnexion.Close


With MaConnexion
    .ConnectionString = l_strconnectstring
    .ConnectionTimeout = 0
    .CommandTimeout = 0
    .Open
End With


OuvreConnection = True
Exit Function
erreur:
MsgBox Err.Description, vbCritical
OuvreConnection = False
End Function


Private Sub cmbCodePrestation_Click()
Set rsPrestation = New ADODB.Recordset
rsPrestation.Open "select* from Prestation where PrestationID = '" & cmbCodePrestation.Text & "' order by PrestationID", MaConnexion, adOpenKeyset
cmbCodePrestation.Text = rsPrestation!PrestationID
lblEdit(12).Caption = rsPrestation!PrestationID
lblEdit(13).Caption = rsPrestation!DesignPrest


End Sub


Private Sub cmbCodeTrait_Click()
Set rsTraitement = New ADODB.Recordset
rsTraitement.Open "select* from Traitement where TraitID = '" & cmbCodeTrait.Text & "' order by TraitID", MaConnexion, adOpenKeyset
cmbCodeTrait.Text = rsTraitement!TraitID
lblEdit(14).Caption = rsTraitement!TraitID
lblEdit(15).Caption = rsTraitement!DesignTrait


End Sub


Private Sub cmbDech_Click()
On Error Resume Next
Set rsDechet = New ADODB.Recordset
rsDechet.Open "select* from Dechet where DechID = '" & cmbDech.Text & "' order by DechID", MaConnexion, adOpenKeyset
cmbDech.Text = rsDechet!DechId
lblEdit(5).Caption = rsDechet!DechId
lblEdit(6).Caption = rsDechet!DesignDech


End Sub


Private Sub cmbInstFin_Click()
On Error Resume Next
Set rsPrestataire = New ADODB.Recordset
rsPrestataire.Open "select* from Prestataire where Nom = '" & cmbInstFin.Text & "' order by Nom", MaConnexion, adOpenKeyset
cmbInstFin.Text = rsPrestataire!Nom
lblEdit(17).Caption = rsPrestataire!Nom
lblEdit(18).Caption = rsPrestataire!SIRET
lblEdit(19).Caption = rsPrestataire!Voie
lblEdit(22).Caption = rsPrestataire!Ville
lblEdit(21).Caption = rsPrestataire!CP
lblEdit(20).Caption = rsPrestataire!DateFinInstFin
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
If CDate(lblEdit(20).Caption) < DTPicker2.Value Then
MsgBox ("Attention l'habilitation de : " & cmbInstFin.Text & " n'est plus valide")
End If
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx


End Sub


Private Sub cmbInstInt_Click()
On Error Resume Next
Set rsPrestataire = New ADODB.Recordset
rsPrestataire.Open "select* from Prestataire where Nom = '" & cmbInstInt.Text & "' order by Nom", MaConnexion, adOpenKeyset
cmbInstInt.Text = rsPrestataire!Nom
lblEdit(29).Caption = rsPrestataire!Nom
lblEdit(30).Caption = rsPrestataire!SIRET
lblEdit(31).Caption = rsPrestataire!Voie
lblEdit(34).Caption = rsPrestataire!Ville
lblEdit(33).Caption = rsPrestataire!CP
lblEdit(32).Caption = rsPrestataire!DateFinInstInt
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
If CDate(lblEdit(32).Caption) > DTPicker2.Value Then
MsgBox ("Attention l'habilitation de : " & cmbInstInt.Text & " n'est plus valide")
End If
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx


End Sub


Private Sub cmbNegoc_Click()
On Error Resume Next
Set rsPrestataire = New ADODB.Recordset
rsPrestataire.Open "select* from Prestataire where Nom = '" & cmbNegoc.Text & "' order by Nom", MaConnexion, adOpenKeyset
cmbNegoc.Text = rsPrestataire!Nom
lblEdit(35).Caption = rsPrestataire!Nom
lblEdit(36).Caption = rsPrestataire!SIRET
lblEdit(37).Caption = rsPrestataire!Voie
lblEdit(40).Caption = rsPrestataire!Ville
lblEdit(39).Caption = rsPrestataire!CP
lblEdit(38) = rsPrestataire!DateFinNegoc
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
If CDate(lblEdit(38).Caption) > DTPicker2.Value Then
MsgBox ("Attention l'habilitation de : " & cmbNegoc.Text & " n'est plus valide")
End If


End Sub


Private Sub cmbProd_Click()
On Error Resume Next
Set rsProducteur = New ADODB.Recordset
rsProducteur.Open "select* from Producteur where NomSite = '" & cmbProd.Text & "' order by NomSite", MaConnexion, adOpenKeyset
cmbProd.Text = rsProducteur!NomSite


lblEdit(0).Caption = rsProducteur!NomSite
lblEdit(1).Caption = rsProducteur!SIRET
lblEdit(2).Caption = rsProducteur!VoieSite
lblEdit(3).Caption = rsProducteur!VilleSite
lblEdit(4).Caption = rsProducteur!CPSite


End Sub


Private Sub cmbTrans_Click()
On Error Resume Next
Set rsPrestataire = New ADODB.Recordset
rsPrestataire.Open "select* from Prestataire where Nom = '" & cmbTrans.Text & "' order by Nom", MaConnexion, adOpenKeyset
cmbTrans.Text = rsPrestataire!Nom
lblEdit(23).Caption = rsPrestataire!Nom
lblEdit(24).Caption = rsPrestataire!SIRET
lblEdit(25).Caption = rsPrestataire!Voie
lblEdit(28).Caption = rsPrestataire!Ville
lblEdit(27).Caption = rsPrestataire!CP
lblEdit(26) = rsPrestataire!DateFinTrans
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
If CDate(lblEdit(26).Caption) > DTPicker2.Value Then
MsgBox ("Attention l'habilitation de : " & cmbTrans.Text & " n'est plus valide")
End If
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx


End Sub


Private Sub DTPicker1_Change()
If lblEdit(5).Caption = "" Then
Beep
cmbDech.SetFocus
Else
lblEdit(7).Caption = DTPicker1.Value
End If


End Sub


Private Sub Form_Load()
On Error Resume Next
'xxxxxxContrôle si la connection est établie avec le serveur xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
  If OuvreConnection(p_strServeur, p_strBase) = True Then
     MsgBox "Connection ouverte " & vbCrLf & _
            "La connection est publique et s'appelle: MaConnexion", vbInformation
  Else
     MsgBox "la connection n'a pu être ouverte"
  End If


SQL = "select* from Registre"
Set rsRegistre = New ADODB.Recordset
rsRegistre.Open SQL, MaConnexion, adOpenKeyset, adLockOptimistic


Set bndRegistre = New BindingCollection
Set bndRegistre.DataSource = rsRegistre


With bndRegistre
   
    .Add lblEdit(0), "Caption", "ProdNom", , "Producteur"
    .Add lblEdit(1), "Caption", "ProdSiret", , "Producteur"
    .Add lblEdit(2), "Caption", "ProdVoie", , "Producteur"
    .Add lblEdit(3), "Caption", "ProdVille", , "Producteur"
    .Add lblEdit(4), "Caption", "ProdCP", , "Producteur"
   
    .Add lblEdit(5), "Caption", "DechID", , "Dechet"
    .Add lblEdit(6), "Caption", "DesignDech", , "Dechet"
   
    .Add lblEdit(7), "Caption", "DateEnl", , "Date enlèvement"


    .Add lblEdit(8), "Caption", "BSDDID", , "BSDD"
    .Add lblEdit(9), "Caption", "Coût", , "Coût"
    .Add lblEdit(10), "Caption", "CoûtTransp", , "Coût transport"
    .Add lblEdit(11), "Caption", "Tonnage", , "Quantité"


    .Add lblEdit(12), "Caption", "PrestationID", , "Prestation"
    .Add lblEdit(13), "Caption", "DesignPrest", , "Désignation prestation"


    .Add lblEdit(14), "Caption", "TraitID", , "Code traitement"
    .Add lblEdit(15), "Caption", "DesignTrait", , "Désignation traitement"
   
    .Add lblEdit(16), "Caption", "DateEntFin", , "Date arrivée"


    .Add lblEdit(17), "Caption", "InstFinaleNom", , "Installation finale"
    .Add lblEdit(18), "Caption", "InstFinaleSIRET", , "Installation finale"
    .Add lblEdit(19), "Caption", "InstFinaleVoie", , "Installation finale"
    .Add lblEdit(20), "Caption", "DateFinInstFin", , "Installation finale"
    .Add lblEdit(21), "Caption", "InstFinalCP", , "Installation finale"
    .Add lblEdit(22), "Caption", "InstFinaleVille", , "Installation finale"


    .Add lblEdit(23), "Caption", "TranspNom", , "Transporteur"
    .Add lblEdit(24), "Caption", "TranspSIREN", , "Transporteur"
    .Add lblEdit(25), "Caption", "TranspVoie", , "Transporteur"
    .Add lblEdit(26), "Caption", "DateFinTrans", , "Transporteur"
    .Add lblEdit(27), "Caption", "TranspCP", , "Transporteur"
    .Add lblEdit(28), "Caption", "TranspVille", , "Transporteur"


    .Add lblEdit(29), "Caption", "InstInterNom", , "Installation inter"
    .Add lblEdit(30), "Caption", "InstInterSIRET", , "Installation inter"
    .Add lblEdit(31), "Caption", "InstInterVoie", , "Installation inter"
    .Add lblEdit(32), "Caption", "DateFinInstInt", , "Installation inter"
    .Add lblEdit(33), "Caption", "InstInterCP", , "Installation inter"
    .Add lblEdit(34), "Caption", "InstInterVille", , "Installation inter"


    .Add lblEdit(35), "Caption", "NegocNom", , "Installation inter"
    .Add lblEdit(36), "Caption", "NegocSIRET", , "Installation inter"
    .Add lblEdit(37), "Caption", "NegocVoie", , "Installation inter"
    .Add lblEdit(38), "Caption", "DateFinNegoc", , "Installation inter"
    .Add lblEdit(39), "Caption", "NegocCP", , "Installation inter"
    .Add lblEdit(40), "Caption", "NegocVille", , "Installation inter"
    .Add text1(0), "Text", "NumEnr", , "Numéro enregistrement"


End With
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
SQLProd = "select* from Producteur"
Set rsProducteur = New ADODB.Recordset
rsProducteur.Open SQLProd, MaConnexion, adOpenKeyset
While Not rsProducteur.EOF
cmbProd.AddItem rsProducteur!NomSite
rsProducteur.MoveNext
Wend
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
SQLPrestation = "select* from Prestation"
Set rsPrestation = New ADODB.Recordset
rsPrestation.Open SQLPrestation, MaConnexion, adOpenKeyset
While Not rsPrestation.EOF
cmbCodePrestation.AddItem rsPrestation!PrestationID
rsPrestation.MoveNext
Wend
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
SQLDechet = "select* from Dechet"
Set rsDechet = New ADODB.Recordset
rsDechet.Open SQLDechet, MaConnexion, adOpenKeyset
While Not rsDechet.EOF
cmbDech.AddItem rsDechet!DechId
rsDechet.MoveNext
Wend
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
SQLTraitement = "select* from Traitement"
Set rsTraitement = New ADODB.Recordset
rsTraitement.Open SQLTraitement, MaConnexion, adOpenKeyset
While Not rsTraitement.EOF
cmbCodeTrait.AddItem rsTraitement!TraitID
rsTraitement.MoveNext
Wend
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
SQLPrestataire = "select* from Prestataire"
Set rsPrestataire = New ADODB.Recordset
rsPrestataire.Open SQLPrestataire, MaConnexion, adOpenKeyset
While Not rsPrestataire.EOF
cmbInstFin.AddItem rsPrestataire!Nom
cmbTrans.AddItem rsPrestataire!Nom
cmbInstInt.AddItem rsPrestataire!Nom
cmbNegoc.AddItem rsPrestataire!Nom
rsPrestataire.MoveNext
Wend
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
DTPicker1.Enabled = False
DTPicker2.Enabled = False
txtNumBord.Enabled = False
txtTonnage.Enabled = False
txtCout.Enabled = False
txtCoutTrans.Enabled = False
lblOK.Visible = False
cmbProd.Enabled = False
cmbDech.Enabled = False
cmbCodePrestation.Enabled = False
cmbCodeTrait.Enabled = False
cmbInstFin.Enabled = False
cmbTrans.Enabled = False
cmbInstInt.Enabled = False
cmbNegoc.Enabled = False


End Sub
Public Sub navigateButtons(strButtonString As String)
'Définition de l'activation des boutons de commandes
'par le biais de la chaîne transmise à strButtonsString
  Dim intIndex As Integer
  Dim intButtonLength As Integer
 
  strButtonString = Trim$(strButtonString)
  intButtonLength = Len(strButtonString)
 
  For intIndex = 1 To intButtonLength
    If (Mid$(strButtonString, intIndex, 1) = "1") Then
      Toolbar1.Buttons(intIndex).Enabled = True
      Toolbar1.Buttons(intIndex).Image = (intIndex)
      Toolbar1.Buttons(intIndex).ToolTipText = Toolbar1.Buttons(intIndex).Tag
      If intIndex <= 4 Then
        mnuNavig.Item(intIndex).Enabled = True
      ElseIf intIndex >= 5 And intIndex <= 7 Then
        mnuEdit.Item(intIndex).Enabled = True
      ElseIf intIndex = 8 And intIndex <= 9 Then
        mnuAction.Item(intIndex).Enabled = True
      ElseIf intIndex = 10 Then
        mnuRechercher.Item(intIndex).Enabled = True
      Else: intIndex = 11
        mnuQuitter.Item(intIndex).Enabled = True
      End If
    Else
      Toolbar1.Buttons(intIndex).Image = (intIndex + 11)
      Toolbar1.Buttons(intIndex).Enabled = False
      If Toolbar1.Buttons(intIndex).Image > 11 Then
        Toolbar1.Buttons(intIndex).ToolTipText = "Non disponible"
      End If
      If intIndex <= 4 Then
        mnuNavig.Item(intIndex).Enabled = False
      ElseIf intIndex >= 5 And intIndex <= 7 Then
        mnuEdit.Item(intIndex).Enabled = False
      ElseIf intIndex >= 8 And intIndex <= 9 Then
        mnuAction.Item(intIndex).Enabled = False
      ElseIf intIndex = 10 Then
        mnuRechercher.Item(intIndex).Enabled = False
      Else: intIndex = 11
        mnuQuitter.Item(intIndex).Enabled = False
      End If
    End If
  Next
 
  'DoEvents
 
End Sub
Public Sub MAJ_BarreEtat(Optional strStatusBar_One As Variant)
'Compte le nombre d'enregistrements de chaque recordset et met à jour la barre d'état.


    lgRegistreAbsPos = rsRegistre.AbsolutePosition
    lgRegistreCount = rsRegistre.RecordCount
    strStatusBar_One = "Il y a " & lgRegistreAbsPos & "/" & lgRegistreCount & " enregistrements dans le registre"
    StatusBar1.Panels.Item(1).Text = strStatusBar_One


End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
'Détecte le bouton de commande utilisé


On Error GoTo erreur


  Static vMyBookMark As Variant  'pour attribuer un signet à l'enregistrement courant


'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
  Select Case Button.Key  'Valeur du bouton de commande sur lequel l'utilisateur a cliqué
   
    Case "btnPremier"
      rsRegistre.MoveFirst
      'Call updateButtons("Navigation")
      'Call MAJ_BarreEtat
   
    Case "btnPrécédent"
      rsRegistre.MovePrevious
      'Call updateButtons("Navigation")
      'Call MAJ_BarreEtat
   
    Case "btnSuivant"
      rsRegistre.MoveNext
      'Call updateButtons("Navigation")
      'Call MAJ_BarreEtat
    If (rsRegistre.BOF) Or (rsRegistre.AbsolutePosition <= 1) Then
    navigateButtons ("00111101011")
    Else
    navigateButtons ("11111101011")
    End If
MsgBox (rsRegistre.AbsolutePosition)
    Case "btnDernier"
      rsRegistre.MoveLast
      'Call updateButtons("Navigation")
      'Call MAJ_BarreEtat
     
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
 
Public Sub updateButtons(strLockEM As String)
'Détermine quel est l'état du jeu d'enregistrement
'(aucune opération d'édition en cours)
'(édition en cours avec l'enregistrement courrant dans la mémoire tampon)
'(ajout d'un enregistrement avec un enregistrement vide en cours)


  
  Set rsRegistre = New ADODB.Recordset
  rsRegistre.Open SQL, MaConnexion, adOpenKeyset, adLockOptimistic


lgRegistreCount = rsRegistre.RecordCount
 
  Select Case strLockEM
    Case "Navigation" 'adEditNone   'pas d'edition en cours, gère simplement la navigation
      If (lgRegistreCount >= 2) Then
        If (rsRegistre.BOF) Or (rsRegistre.AbsolutePosition = 1) Then
        'Appelle de la procédure navigateButtons avec passage d'argument
        'L'argument est une chaîne de 11 "0 ou 1" représentant l'état des 11 boutons de commandes
            navigateButtons ("00111101011")
          Else
            navigateButtons ("00111101001")
          End If
        ElseIf (rsRegistre.EOF) Or (rsRegistre.AbsolutePosition = lgRegistreCount) Then

            navigateButtons ("11001101011")
          Else
            navigateButtons ("11001101001")
          End If
            navigateButtons ("11111101011")

    Case "Edition"   'Modification de l'enregistrement courant en cours
      navigateButtons ("00000010100")
    Case "Ajout"    'Ajout d'un nouvel enregistrement en cours
      navigateButtons ("00000010100")
    End Select


End Sub
Private Sub SuppressionEnreg()
'Cette procédure évite d'écrire ce code deux fois au niveau du bouton suppression de la barre d'outils
       
 Dim i As Integer
 
  With rsRegistre
    .Delete
    MAJ_BarreEtat
    lgRegistreCount = lgRegistreCount - 1
    If (lgRegistreCount > 0) Then
      If .BOF Or lgRegistreCount = 0 Then
        .MoveFirst
      Else
        .MovePrevious
      End If
    'Else
    '  If Me.ActiveControl.Tag = "1" Then
    '  For i = 0 To Text1.Count - 1
    '    Me.Text1(i) = ""
    '  Next i
    '  End If
    End If
  End With
  text1(0).SetFocus
       
End Sub
Private Sub cmbCodePrestation_GotFocus()
If lblEdit(11).Caption = "" Then
Beep
txtTonnage.SetFocus
End If
End Sub


Private Sub cmbCodeTrait_GotFocus()
If lblEdit(13).Caption = "" Then
Beep
cmbCodePrestation.SetFocus
End If
End Sub


Private Sub cmbDech_GotFocus()
If lblEdit(0).Caption = "" Then
Beep
cmbProd.SetFocus
End If
End Sub


Private Sub cmbInstFin_GotFocus()
    If lblEdit(16).Caption = "" Then
    Beep
    DTPicker2.SetFocus
    End If
End Sub


Private Sub cmbInstInt_GotFocus()
        If lblEdit(20).Caption = "" Then
    Beep
        ElseIf lblEdit(20).Caption = "" Then
        MsgBox ("Le transporteur est obligatoire!")
      cmbInstFin.SetFocus
    End If


End Sub


Private Sub cmbNegoc_GotFocus()
    If lblEdit(25).Caption = "" Then
    Beep
    cmbInstInt.SetFocus
    End If
End Sub


Private Sub cmbTrans_GotFocus()
    If lblEdit(18).Caption = "" Then
    Beep
        ElseIf lblEdit(18).Caption = "" Then
        MsgBox ("L'installation finale est obligatoire!")
      cmbInstFin.SetFocus
    End If
End Sub


Private Sub DTPicker1_LostFocus()
DTPicker2.Value = DTPicker1.Value
End Sub


Private Sub DTPicker2_GotFocus()
'Contrôle des dates
If lblEdit(15).Caption = "" Then
Beep
cmbCodeTrait.SetFocus
ElseIf DTPicker1.Value > DTPicker2.Value Then
    MsgBox ("La date d'arrivée sur le site final est erronée")
    lblEdit(16).Caption = ""
    DTPicker2.SetFocus
Else
lblEdit(16).Caption = DTPicker2.Value
End If


End Sub


Private Sub DTPicker2_LostFocus()
'Contrôle des dates
If lblEdit(15).Caption = "" Then
Beep
cmbCodeTrait.SetFocus
ElseIf DTPicker1.Value > DTPicker2.Value Then
    MsgBox ("La date d'arrivée sur le site final est erronée")
    lblEdit(16).Caption = ""
    DTPicker2.SetFocus
Else
lblEdit(16).Caption = DTPicker2.Value
End If


End Sub


Private Sub txtCoutTrans_Change()
lblEdit(10).Caption = txtCoutTrans


End Sub


Private Sub txtNumBord_Change()
lblEdit(8).Caption = txtNumBord.Text
End Sub


Private Sub txtNumBord_GotFocus()
If lblEdit(7).Caption = "" Then
Beep
DTPicker1.SetFocus
End If
End Sub
Private Sub txtTonnage_Change()
lblEdit(11).Caption = txtTonnage.Text
End Sub
Private Sub txtTonnage_GotFocus()
If lblEdit(10).Caption = "" Then
Beep
txtCout.SetFocus
End If
End Sub
Private Sub txtCoutTrans_GotFocus()
If lblEdit(9).Caption = "" Then
Beep
DTPicker1.SetFocus
End If


End Sub


Private Sub txtCoutTrans_KeyPress(ToucheAscii As Integer)
'---- Appui sur une touche
    ' Contrôle la validité de la saisie
    If (ToucheAscii < Asc("0") Or ToucheAscii > Asc("9")) And ToucheAscii <> 8 And ToucheAscii <> 44 Then
        Beep


        ' Erreur : supprime le caractère
        ToucheAscii = 0
    End If


End Sub


Private Sub txtTonnage_KeyPress(ToucheAscii As Integer)
'---- Appui sur une touche
    ' Contrôle la validité de la saisie
    If (ToucheAscii < Asc("0") Or ToucheAscii > Asc("9")) And ToucheAscii <> 8 And ToucheAscii <> 44 Then
        Beep


        ' Erreur : supprime le caractère
        ToucheAscii = 0
    End If
End Sub
Private Sub txtCout_Change()
lblEdit(9).Caption = txtCout.Text
End Sub


Private Sub txtCout_GotFocus()
If lblEdit(8).Caption = "" Then
Beep
txtNumBord.SetFocus
End If
End Sub


Private Sub txtCout_KeyPress(ToucheAscii As Integer)
'---- Appui sur une touche
    ' Contrôle la validité de la saisie
    If (ToucheAscii < Asc("0") Or ToucheAscii > Asc("9")) And ToucheAscii <> 8 And ToucheAscii <> 44 Then
       
        Beep


        ' Erreur : supprime le caractère
        ToucheAscii = 0
    End If


End Sub


 

3 réponses

Messages postés
7393
Date d'inscription
mercredi 23 avril 2003
Statut
Membre
Dernière intervention
6 avril 2012
58
Salut,
Extrait de la MSDN.
AbsolutePosition, propriété
[...]

En l'absence d'enregistrement en cours (si l'objet Recordset est vide,
par exemple), la propriété AbsolutePosition renvoie la valeur –1. Si
l'enregistrement en cours est supprimé, la valeur de la propriété
AbsolutePosition n'est pas définie et une erreur récupérable se produit
si elle est référencée. Les nouveaux enregistrements sont ajoutés à la fin du
jeu d'enregistrements.

@+: Ju£i?n
Pensez: Réponse acceptée
Messages postés
7393
Date d'inscription
mercredi 23 avril 2003
Statut
Membre
Dernière intervention
6 avril 2012
58
Re,
Oups je sais pas ce qui c'est passé ce n'est pas ?1 qui aurait du s'afficher mais -1

@+: Ju£i?n
Pensez: Réponse acceptée
Messages postés
36
Date d'inscription
mardi 3 août 2004
Statut
Membre
Dernière intervention
9 novembre 2007

Salut et merci pour la rapiditée de ta réponse. Ce que je ne comprends pas c'est que lorsque je navigue dans la base par MOVENEXT, MOVEPREVIOUS, etc, les enregistrements s'affichent normalement.
Si tu rajoutes un msgbox(rsRegistre.Count), le résultat est juste ! Il n'y a que lorsque j'appelle UpdateButtons que le recordset affiche -1 ou -3.

Sais-tu où ça merdouille ?

@+  Lap2