Sujet Précédent Sujet Suivant

SQL Server VB6

lap2 Messages postés 36 Date d'inscription mardi 3 août 2004 Statut Membre Dernière intervention 9 novembre 2007 - 24 juin 2007 à 10:58
lap2 Messages postés 36 Date d'inscription mardi 3 août 2004 Statut Membre Dernière intervention 9 novembre 2007 - 24 juin 2007 à 19:28
Bonjour à tous,

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

Exemple :

msgbox (rsRecord.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 ?

@+

Lap2

2 réponses

Réponse 1 / 2
PCPT Messages postés 13272 Date d'inscription lundi 13 décembre 2004 Statut Membre Dernière intervention 3 février 2018 47
24 juin 2007 à 12:59
salut,
tu utilises une picturebox ou un timer pour faire ta requête?

tu vois où je veux en venir?
j'peux pas être plus clair...

<hr size="2" width="100%" />Prenez un instant pour répondre à [infomsg_SONDAGE-POP3-POUR-CS_769706.aspx ce sondage] svp
0
Réponse 2 / 2
lap2 Messages postés 36 Date d'inscription mardi 3 août 2004 Statut Membre Dernière intervention 9 novembre 2007
24 juin 2007 à 19:28
T'as raison, je te passe le code,

Le problème apparaît dans UPDATEBUTTONS

@+

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
    Case "btnAjouter"
   
cmbProd.Enabled = True
cmbDech.Enabled = True
DTPicker1.Enabled = True
DTPicker2.Enabled = True
txtNumBord.Enabled = True
txtTonnage.Enabled = True
txtCout.Enabled = True
txtCoutTrans.Enabled = True
txtNumBord.Locked = False
txtTonnage.Locked = False
txtCout.Locked = False
txtCoutTrans.Locked = False
cmbCodePrestation.Enabled = True
cmbCodeTrait.Enabled = True
cmbInstFin.Enabled = True
cmbTrans.Enabled = True
cmbInstInt.Enabled = True
cmbNegoc.Enabled = True
lblOK.Visible = True
     
      With rsRegistre
        If (lgRegistreCount > 0) Then
          vMyBookMark = .Bookmark
        Else
          vMyBookMark = ""
        End If
        .AddNew
        'Call updateButtons("Ajout")
        'If Me.ActiveControl.Tag = "1" Then
        '  strStatusBar_One = "Ajout d'un nouvel Editeur..."
        'ElseIf Me.ActiveControl.Tag = "3" Then
        '  strStatusBar_One = "Ajout d'un nouvel ouvrage..."
        'End If
        'strStatusBar_Two = "Ajout en cours..."
        Call MAJ_BarreEtat(strStatusBar_One)
      End With
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
    Case "btnAnnuler"
On Error Resume Next


cmbProd.Enabled = False
cmbDech.Enabled = False
DTPicker1.Enabled = False
DTPicker2.Enabled = False
txtNumBord.Enabled = False
txtTonnage.Enabled = False
txtCout.Enabled = False
txtCoutTrans.Enabled = False
txtNumBord.Locked = True
txtTonnage.Locked = True
txtCout.Locked = True
txtCoutTrans.Locked = True
cmbCodePrestation.Enabled = False
cmbCodeTrait.Enabled = False
cmbInstFin.Enabled = False
cmbTrans.Enabled = False
cmbInstInt.Enabled = False
cmbNegoc.Enabled = False
lblOK.Visible = False
     
      With rsRegistre
        .CancelBatch
        If (Len(vMyBookMark)) Then
          .Bookmark = vMyBookMark
        End If
        If Me.ActiveControl.Tag = 3 Then
          text1(0).Enabled = True
          text1(0).SetFocus
        End If
        'Call updateButtons("Navigation")
        Call MAJ_BarreEtat
      End With
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
    Case "btnEditer"
On Error Resume Next
cmbProd.Enabled = True
cmbDech.Enabled = True
DTPicker1.Enabled = True
DTPicker2.Enabled = True
txtNumBord.Enabled = True
txtTonnage.Enabled = True
txtCoutTrans.Enabled = True
txtCout.Enabled = True
txtNumBord.Locked = False
txtTonnage.Locked = False
txtCoutTrans.Locked = False
txtCout.Locked = False
cmbCodePrestation.Enabled = True
cmbCodeTrait.Enabled = True
cmbInstFin.Enabled = True
cmbTrans.Enabled = True
cmbInstInt.Enabled = True
cmbNegoc.Enabled = True
lblOK.Visible = True
     
      With rsRegistre
        vMyBookMark = .Bookmark
        'Call updateButtons("Edition")
        If Me.ActiveControl.Tag = "1" Then
          strStatusBar_One = "Modification de la fiche de l'Editeur..."
        ElseIf Me.ActiveControl.Tag = "3" Then
          strStatusBar_One = "Modification de la fiche de l'ouvrage..."
        End If
        'strStatusBar_Two = "Modification en cours..."
        Call MAJ_BarreEtat(strStatusBar_One)
      End With
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
    Case "btnValider"     If lblEdit(0).Caption "" Or lblEdit(5).Caption "" Or lblEdit(7).Caption = "" Or lblEdit(8).Caption = "" Or lblEdit(9).Caption = "" Or lblEdit(10).Caption = "" Or lblEdit(11).Caption = "" Or lblEdit(12).Caption = "" Or lblEdit(14).Caption = "" Or lblEdit(16).Caption = "" Or lblEdit(17).Caption = "" Or lblEdit(23).Caption = "" Or lblEdit(29).Caption = "" Or lblEdit(35).Caption = "" Then
    MsgBox ("Vous devez renseigner tous les champs !")
rsRegistre.CancelUpdate
 
'Call updateButtons("Navigation")


cmbProd.Enabled = False
cmbDech.Enabled = False
DTPicker1.Enabled = False
DTPicker2.Enabled = False
txtNumBord.Enabled = False
txtTonnage.Enabled = False
txtCout.Enabled = False
txtCoutTrans.Enabled = False
txtNumBord.Locked = True
txtTonnage.Locked = True
txtCout.Locked = True
txtCoutTrans.Locked = True
cmbCodePrestation.Enabled = False
cmbCodeTrait.Enabled = False
cmbInstFin.Enabled = False
cmbTrans.Enabled = False
cmbInstInt.Enabled = False
cmbNegoc.Enabled = False
lblOK.Visible = False
Else
On Error Resume Next
     With rsRegistre
        'If (.EditMode <> adEditNone) Then
        '  If .EditMode = adEditAdd Then
'            If Me.ActiveControl.Tag = "3" Then
'              rsTitles!PubID = rsPub!PubID
'              DataGrid1.Columns(3) = rsPub!PubID
'              DataGrid1.EditActive = False    'Sinon, la cellule en cours de saisie reste active
'                                                            'et provoque une erreur
'              DataGrid1.Col = 0      'Sinon, le focus sera sur la colonne en cours si on re-saisit un
'                                              'nouvel enregistrement tout de suite après
'            End If
'           End If
'          If Validation() = True Then'            If .RecordCount 1 And Me.ActiveControl.Tag "1" Then PremierEnregistrement_Validation
            .Update
            'Call updateButtons("Navigation")
            Call MAJ_BarreEtat
         ' End If
        'End If
      End With
cmbProd.Enabled = False
cmbDech.Enabled = False
DTPicker1.Enabled = False
DTPicker2.Enabled = False
txtNumBord.Enabled = False
txtTonnage.Enabled = False
txtCout.Enabled = False
txtCoutTrans.Enabled = False
txtNumBord.Locked = True
txtTonnage.Locked = True
txtCout.Locked = True
txtCoutTrans.Locked = True
cmbCodePrestation.Enabled = False
cmbCodeTrait.Enabled = False
cmbInstFin.Enabled = False
cmbTrans.Enabled = False
cmbInstInt.Enabled = False
cmbNegoc.Enabled = False
lblOK.Visible = False
End If


'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
    Case "btnSupprimer"
      Dim intResponse As Integer
      Dim strMessage As String
'      If Me.ActiveControl.Tag = "1" And rsTitles.RecordCount > 0 Then
'          strMessage = "Cette fiches Editeur est liées à une ou des fiches Ouvrage. " & vbCr & _
'                                "Voulez vous supprimer les fiches Ouvrages avec la fiche Editeur? " & vbCr & _
'                                "Cette suppression est irréversible"
'          intResponse = MsgBox(strMessage, vbQuestion + vbYesNo + vbDefaultButton2, "Table Ouvrages")
'          If (intResponse = vbYes) Then   'Suppression des enregistrements secondaires...
'            While rsTitles.RecordCount > 0
'              rsRegistre.Delete
'            Wend
'            Call SuppressionEnreg   '... puis suppression de l'enregistrement principal
'          End If
'      Else
        strMessage = "Etes vous sûr de vouloir supprimer cet enregistrement?"
        intResponse = MsgBox(strMessage, vbQuestion + vbYesNo + vbDefaultButton2, "Table Editeurs")
        If (intResponse = vbYes) Then
          Call SuppressionEnreg   'Suppression de l'enregistrement en cours (principal ou secondaire)
        End If
        Me.text1(0).SetFocus
     
      'Call updateButtons("Navigation")
      Call MAJ_BarreEtat


'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
     
    Case "btnRechercher"
      Dim iReturn As Integer
      gFindString = ""
      'strStatusBar_Two = ""
      'strStatusBar_Two = "Recherche en cours..."
      Call MAJ_BarreEtat(strStatusBar_One)
      With frmRechercher
        .AddCaption = "Entrez le nom de l'éditeur à trouver"
        .recordSource = "SELECT Name FROM Publishers ORDER BY Name"
        .Show vbModal
      End With
      DoEvents
     
      If (Len(gFindString) > 0) Then
        With rsRegistre          If Not .BOF True Or Not .EOF True Then
           .MoveFirst
          .Find "Name =  '" & gFindString & "' "
            If .EOF Or .BOF Then
              iReturn = MsgBox("L'éditeur " & gFindString & _
                    " n'a pas été trouve.", vbCritical, "Editeur")
              .MoveFirst
            End If
          End If
        End With
      End If
      updateButtons ("Navigation")
      Call MAJ_BarreEtat
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
    Case "btnTerminer"
      Unload Me
     
  End Select
 
  Exit Sub
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx


erreur:


  Select Case Err.Number
    Case 5
      MsgBox "btnclick"
      Resume Next
    Case 3200
    'Enregistrements connexes
      MsgBox "Il est impossible de supprimer cette fiche." & _
        " car il y a au moins un enregistrement liés."
      'FlagErreur = True
      Resume Next
    Case 3426
      'Evènement annulé par objet associé
      Resume Next
    Case Else
      MsgBox ("Erreur n° " & Err.Number & " - Description: " & _
          Err.Description & " - Source: " & Err.Source & " - Sub 5")
      Resume Next
  End Select
 
End Sub
Private Sub lockTheControls(strLockEM As String)
End Sub


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)


  'If Me.ActiveControl.Tag "1" Or Me.ActiveControl.Tag "2" Then
  '  Set recordsetEC = rsPub
  '  lgTotalRecordsEC = lgTotalPublishers
  'ElseIf Me.ActiveControl.Tag = "3" Then
  '  Set recordsetEC = rsTitles
  '  lgTotalRecordsEC = lgTotalOuvrages
  'End If
 
  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
        '  If (Me.ActiveControl.Tag <> "3") Then
            navigateButtons ("00111101011")
          Else
            navigateButtons ("00111101001")
          End If
        ElseIf (rsRegistre.EOF) Or (rsRegistre.AbsolutePosition = lgRegistreCount) Then
        '  If (Me.ActiveControl.Tag <> "3") Then
            navigateButtons ("11001101011")
          Else
            navigateButtons ("11001101001")
          End If
        'Else
        '  If (Me.ActiveControl.Tag <> "3") Then
            navigateButtons ("11111101011")
          'Else
            navigateButtons ("11111101001")
          'End If
        'End If
      'If (lgRegistreCount > 0) Then
      '  navigateButtons ("00001101001")
      'Else
      '  navigateButtons ("00001000001")
      'End If
      'Call lockTheControls(strLockEM)
    Case "Edition"   'Modification de l'enregistrement courant en cours
      'Call lockTheControls("Edition")
      'If Not (TypeOf Me.ActiveControl Is DataGrid) Then
      '  txtEdit(1).SetFocus
      'End If
      navigateButtons ("00000010100")
    Case "Ajout"    'Ajout d'un nouvel enregistrement en cours
      'Call lockTheControls("Ajout")
      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


 
0

Discussions similaires

LPAD, RPAD avec SQl server?
cs_karn -
IgorN2004 -

3 réponses
decimal (12,2) ca veut dire quoi?
cs_deubal -
Momo13 -

3 réponses
SQL Server : Echec de la conversion varchar en int
Maelhia -
Maelhia -

5 réponses
foreach en SQL ?
bootchoz -
bootchoz -

5 réponses
If et else dans stored procedure
issoux -
issoux -

2 réponses
Rejoignez-nous