lap2
Messages postés36Date d'inscriptionmardi 3 août 2004StatutMembreDernière intervention 9 novembre 2007
-
25 juin 2007 à 08:56
lap2
Messages postés36Date d'inscriptionmardi 3 août 2004StatutMembreDernière intervention 9 novembre 2007
-
25 juin 2007 à 09:11
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
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
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
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
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
jrivet
Messages postés7392Date d'inscriptionmercredi 23 avril 2003StatutMembreDernière intervention 6 avril 201260 25 juin 2007 à 09:00
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.
lap2
Messages postés36Date d'inscriptionmardi 3 août 2004StatutMembreDernière intervention 9 novembre 2007 25 juin 2007 à 09:11
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.
