Proble de base de donnees

thunderpat59199 Messages postés 32 Date d'inscription mardi 10 avril 2007 Statut Membre Dernière intervention 28 décembre 2007 - 4 juin 2007 à 19:53
cs_Nicko11 Messages postés 1141 Date d'inscription mercredi 7 mars 2007 Statut Membre Dernière intervention 19 septembre 2007 - 6 juin 2007 à 08:17
j'ai un problème de table avec vb

j'ai crée sur access97 une deuxieme table son nom c'est Tbljournal2
pour mon programme vb voici ce que j'ai mit pour la sauvegarde.

l'erreur c'est qu'il ne reconnait pas la table
il me dit variable not defined

c adojournal2 qui est selectionné

If b > 0 Then
    With Adojournal2.Recordset
             .AddNew
             !Utilisateurs = CmbUtilisateurs.Text
             !numéro_de_commande = TxtNumComm.Text
             !Date = Date
             !Heure = Time
             !tension_desirée = TxtTension.Text
             !tension_obtenue = LblAffichage.Caption
             !Unité = CmbUnité.Text
             If txtremarques.Text = "" Then
                GoTo rienfaire
            Else
             !REMARQUES = txtremarques.Text
            End If
rienfaire:
             .Update
             .Save
             .Requery
    End With

7 réponses

cs_Jack Messages postés 14007 Date d'inscription samedi 29 décembre 2001 Statut Modérateur Dernière intervention 28 août 2015 78
4 juin 2007 à 20:36
Salut
Oh qu'il est pas beau ce Goto alors que tu as tout ce qu'il faut pour éviter cette méchante structure. Bref, ce n'est pas le sujet.
Pour le RecordSet, c'est un peu normal.
Où est la connexion entre ce RecordSet et ta table TblJournal2 ? je n'en vois pas
Vérifie la définition de AdoJournal2
Vérifie aussi que le nom des champs que tu utilises soient dans le même ordre et aient la même orthographe que ceux déclarés dans ta table.
Donc, même si ton txtRemarques ne contient rien, il faut quand même l'utiliser, quitte à le laisser vide avec "" ou lui associer un Null

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Champion du monde de boule de cristal - 2005
Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)
0
thunderpat59199 Messages postés 32 Date d'inscription mardi 10 avril 2007 Statut Membre Dernière intervention 28 décembre 2007
5 juin 2007 à 05:50
je n'ai pas fait la connexion entre recordset et tbljournal2 car je sais pas comment il faut faire
0
cs_Nicko11 Messages postés 1141 Date d'inscription mercredi 7 mars 2007 Statut Membre Dernière intervention 19 septembre 2007 3
5 juin 2007 à 08:14
Salut,

je pense donc tu aurais pu commencer par la. Pour se connecter à une base de données (en ADO j'en déduis vu le nom Adojournal2) :

Vas dans Projet -> Référence et coches Microsoft Active Data Object 2.8

Ensuite mets ce code et remplace ce qu'il y a en gras par le chemin complet du fichier :

Set acn = New ADODB.connection
acn.CursorLocation = adUseClient
acn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Chemin_Du_Fichier_mdb
                                                                           
Si la méthode Open ne plante pas, tu seras connecté à ta base.

Par contre, je comprend pas ce que ta facon de faire car tu nous parles de la table Tbljournal2  et ensuite dans ton code tu mets Adojournal2. C'est quoi ce dernier truc, je vois pas de déclarations donc normal que VB ne vois pas de quoi tu parles.

Tu n'aurais pas recopié ce code quelque part ?
0
thunderpat59199 Messages postés 32 Date d'inscription mardi 10 avril 2007 Statut Membre Dernière intervention 28 décembre 2007
5 juin 2007 à 09:15
oui j'ai repris un programme existant. Ce programme fonctionnait avec une carte d'acquisition analogique, je l'ai remplacé par un automate qui lui envoi les données sur le port com.
Ce programme possède déja sa base de données.
Moi j'ai ouvert la base de données sur access et j'ai copié la table Tbljournal et je l'ai renommer en Tbljournal2.
moi je voudrais ecrire les données sur Tbljournal2 sur vb
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
cs_Nicko11 Messages postés 1141 Date d'inscription mercredi 7 mars 2007 Statut Membre Dernière intervention 19 septembre 2007 3
5 juin 2007 à 13:47
Ok, bon lache ta source pour l'instant et fais les choses morceaux par morceaux au lieu de t'attaquer au projet entier.

Ce que tu cherches a faire, c'est manipuler des données présentes dans une base de données.

Fais donc ce que j'ai dit au précédent post et rajoute cela ensuite.

Set rs= New ADODB.Recordset
rs.CursorLocation = adUseClient
rs.Open "SELECT * FROM Nom_table ", acn, adOpenDynamic, adLockOptimistic

Si tu remplaces ce qu'il y a en gras par ce qu'il faut, tu pourras grace au recordset, récupérer les données de ta base en faisant cela (remplaces par le nom de ton champ):
ta_variable = rs.fields("Nom_champ")

Si tu veux passé à la ligne suivante de ta base de données, tu fais :
rs.MoveNext

En principe tu as tout ce qu'il te faut pour lire, modifier les données de ta base. Si tu as un soucis, décris bien ce que tu as fait et la ou tu rencontre un pb.

A+
0
thunderpat59199 Messages postés 32 Date d'inscription mardi 10 avril 2007 Statut Membre Dernière intervention 28 décembre 2007
5 juin 2007 à 17:42
voici ma source du prog et je voudrais integrer  la table  tbljournal2

Public Device As Integer  ' variable pour numéroter la carte
Public passadm As String   ' mot de passe adm
Public passwadm As String    ' mot de passe adm
Public valaffiche As Double   ' la valeur qui va s'afficer apres lecture de la carte
Public a As Double

Public i As Integer          ' variable pour compter 40 sec avant 2eme enrigistrement
Public j As Integer         ' pour sauvegarder une seul fois en apuyant plusieurs fois sur enrigistrer dans le meme essai
Public k As Integer       ' pour rafraichir lors de l'affichage et empecher une boucle infini
Option Explicit

Private Sub changepassword_Click()
FrmChangepassutil.Visible = True
     lstchangepassutil.BoundText = False
     menu.Enabled = False
End Sub

Private Sub changepasswoudadm_Click()
    Frmchangepassadm.Visible = True
    Txtchangepassadm1.SetFocus
    menu.Enabled = False
End Sub

Private Sub CmbUnité_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        TxtTension.SetFocus
    End If

End Sub

Private Sub CmbUtilisateurs_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        TxtPassutilisateur.SetFocus
    End If
End Sub

Private Sub CmdActivationmenu_Click()
Frmutilisateur.Visible = False
    FrmMain.Visible = False
    Frmmotdepassemenu.Visible = True
    Txtmotdepassemenu.SetFocus
End Sub

Private Sub CmdAnnulation_Click()
    FrmAffichage.Visible = False
    Timer2.Enabled = False
    Timer3.Enabled = False
    FrmMain.Visible = True
    CmdEssai.SetFocus
End Sub

Private Sub CmdAnnulerComm_Click()
TxtNumComm.Text = ""
    TxtTension.Text = ""
    CmbUnité.ListIndex = 0
    TxtPassword.Text = ""
    TxtPassutilisateur.Text = ""
    Txtconvertion.Text = ""
    TxtNumComm.SetFocus
End Sub

Private Sub Cmdchangementgrid_Click()
    FrmJournalliste.FontItalic = True
    DataGrid1.Visible = False
    DataGrid2.Visible = True
    Cmdretourjournalliste.SetFocus
End Sub

Private Sub Cmdchangepassadm_Click()
    If Txtchangepassadm3.Text = Txtchangepassadm2.Text Then
       With AdoAdm.Recordset
       .Update
        If Not .EOF Then
            If Not .EOF Then
                .Delete
                .Update
            End If
        Else
            MsgBox "Table vide", vbCritical, "Attention"
        End If
       End With
    lstsupputil.ReFill
        With AdoAdm.Recordset
            .AddNew
            !administrateur = "administrateur"
            !passadm = Txtchangepassadm3.Text
            .Update
            .Requery
        End With
            Txtchangepassadm1.Text = ""
            Txtchangepassadm2.Text = ""
            Txtchangepassadm3.Text = ""
            Frmchangepassadm.Visible = False
            menu.Enabled = False
    Else
            MsgBox "Retappez votre nouveau mot de passe", vbOKOnly, "ERREUR"
            Txtchangepassadm2.Text = ""
            Txtchangepassadm3.Text = ""
            Txtchangepassadm2.SetFocus
    End If
End Sub

Private Sub CmdChangepassutil_Click()
Dim UserName2 As String
    UserName2 = lstchangepassutil.BoundText
    With AdoUtil.Recordset
        If Not .EOF Then
            .MoveFirst
            .Find "Utilisateurs = '" & UserName2 & "'"
            If Not .EOF Then
                .Delete
                .Update
            End If
        Else
            MsgBox "Table vide", vbCritical, "Attention"
        End If
    End With
    lstsupputil.ReFill
    With AdoUtil.Recordset
        .AddNew
        !Utilisateurs = UserName2
        !Password = TxtChangepassutil.Text
        .Update
        .Requery
    End With
    TxtChangepassutil.Text = ""
End Sub

Private Sub Cmdcherchenumcommandejournalliste_Click()
With Adojournal.Recordset
        .MoveFirst
        .Find "numéro_de_commande = '" & Txtcherchenumcommandejournalliste.Text & "'"
    End With
        DataGrid1.RecordSelectors = True
        DataGrid2.RecordSelectors = True
        Txtcherchenumcommandejournalliste.Text = ""
End Sub

Private Sub CmdConfComm_Click()
'regulation de saisie
    If (TxtNumComm.Text = "") Then
        MsgBox "Le Numéro de Commande ne peut pas être vide", vbOKOnly, "Erreur de Saisie"
        TxtNumComm.SetFocus
        GoTo lErreur
    End If
    If (TxtTension.Text = "") Then
        MsgBox "La tension ne peut pas être vide", vbOKOnly, "Erreur de Saisie"
        TxtTension.SetFocus
        GoTo lErreur
    End If
    'limitation de la force à 999 tf ou 9999 KN
    If CmbUnité.ListIndex = 1 Then
        If (TxtTension.Text > 999) Then
            MsgBox "Attention: Tension plus que la limite", vbOKOnly, "ERREUR DE LIMITE"
            TxtTension.Text = ""
            Txtconvertion.Text = ""
            TxtTension.SetFocus
            GoTo lErreur
        End If
    Else
        If (TxtTension.Text > 9999) Then
            MsgBox "Attention: Tension plus que la limite", vbOKOnly, "ERREUR DE LIMITE"
            TxtTension.Text = ""
            Txtconvertion.Text = ""
            TxtTension.SetFocus
            GoTo lErreur
        End If
    End If
    FrmCommande.Visible = False
    FrmConfirmcombox.Visible = True
    Txtconfirmcomnumcom.Text = TxtNumComm.Text
    Txtconfirmcomboxtension.Text = TxtTension.Text
    Txtconfirmcomunit1.Text = CmbUnité.Text
    If CmbUnité.ListIndex = 1 Then
        Txtconfirmcomtensconv.Text = (TxtTension.Text * 9.81)
        Txtconfirmcomunitconv.Text = "Kilo newton"
    ElseIf CmbUnité.ListIndex = 0 Then
        Txtconfirmcomtensconv.Text = (TxtTension.Text / 9.81)
        Txtconfirmcomunitconv.Text = "Tonne force"
    End If
    Cmdconfirmcomboxok.SetFocus
lErreur:
End Sub

Private Sub Cmdconfirmcomboxannuler_Click()
FrmConfirmcombox.Visible = False
        FrmCommande.Visible = True
        TxtNumComm.Text = ""
        TxtTension.Text = ""
        Txtconvertion.Text = ""
        txtremarques.Text = ""
        TxtNumComm.SetFocus
End Sub

Private Sub Cmdconfirmcomboxok_Click()
Dim initsubsystem As Long
    Dim InitSRDevice As Long
    j = 0
    FrmConfirmcombox.Visible = False
    FrmAffichage.Visible = True
    Lblmaxaff.Caption = ("Tension maximale de rupture: " & TxtTension.Text & "  " & CmbUnité.Text & _
    vbCrLf & " Numéro du commande: " & TxtNumComm.Text & ".")
    Cmdsauvgarde.SetFocus
    FrmCommande.Visible = False
End Sub

Private Sub CmdCopiage_Click()
Dim dbjournal, accessjournal, dat
    Set dbjournal = CreateObject("Scripting.FileSystemObject")
    Set accessjournal = dbjournal.GetFile("c:\Program files\PrjMarit\bdd1.mdb")
    dat = accessjournal.DateCreated
    'copiage du journal sur une disquette
    On Error Resume Next
    MsgBox " Veuillez inserez une disquette", vbOKOnly, "ATTENTION"
    accessjournal.Copy ("a:")
End Sub

Private Sub CmdEssai_Click()
'Initialisation
    TxtNumComm.Text = ""
    TxtTension.Text = ""
    Txtconvertion.Text = ""
    txtremarques.Text = ""
    CmbUnité.ListIndex = 1
    Dim row As Integer
    Dim row1 As Integer
    Dim vide As Integer
    Dim nbressai As Integer
  
    'CmbUtilisateurs.ListIndex = 0
    TxtPassword.Text = ""
    TxtPassutilisateur.Text = ""
    Txtconvertion.Text = ""

    FrmMain.Visible = False
    FrmCommande.Visible = True
    'Affichage du numéro d'essai
    Dim nbresai As Integer
   With Adojournal.Recordset
       On Error Resume Next
       .MoveLast
       nbresai = !N°
    End With
    Lblnombressai.Caption = "Essais Numéro: " & nbresai + 1
    TxtNumComm.SetFocus
End Sub

Private Sub CmdJournal_Click()
FrmMain.Visible = False
    FrmCommande.Visible = False
    FrmSécurit.Visible = True
    TxtPassword.SetFocus
End Sub

Private Sub CmdMainRetour_Click()
Frmutilisateur.Visible = True
    CmbUtilisateurs.SetFocus
    menu.Enabled = False
End Sub

Private Sub Cmdmotdepassecopiage_Click()
    Dim passwadm As String
    With AdoAdm.Recordset
                .MoveFirst
                'trouver "administrateur"
                passwadm = !passadm
    End With
    If Txtmotdepassecopiage.Text = passwadm Then
       Frmmotdepassecopiage.Visible = False
       Frmutilisateur.Visible = False
       FrmMain.Visible = False
       Frmcopiage.Visible = True
       CmdCopiage.SetFocus
       menu.Enabled = False
       Txtmotdepassecopiage.Text = ""
    Else
       Txtmotdepassecopiage.Text = ""
   End If
End Sub

Private Sub Cmdnouveautil_Click()
If Not (Txtnouveautil.Text = "") Then
        If Not (Txtnouveautilpass.Text = "") Then
            With AdoUtil.Recordset
                .AddNew
                !Utilisateurs = Txtnouveautil.Text
                !Password = Txtnouveautilpass.Text
                .Update
                .Requery
            End With
            Txtnouveautil.Text = ""
            Txtnouveautilpass.Text = ""
            Cmdretournouveautil.SetFocus
        Else
            Txtnouveautil.SetFocus
        End If
    Else
            Txtnouveautil.SetFocus
    End If
End Sub

Private Sub CmdPassword_Click()
Dim passwadm As String
      With AdoAdm.Recordset
           .MoveFirst
          '.trouver "administrateur"
            passwadm = !passadm
      End With
      If TxtPassword.Text = passwadm Then
         MsgBox "bien Venu :)", vbOKOnly, "Administrateur"
         TxtPassword.Text = ""
         'affichage du journal
         FrmSécurit.Visible = False
         FrmJournalliste.Visible = True
         Cmdretourjournalliste.SetFocus
      Else
         MsgBox "Retapez le mot de passe", vbOKOnly, "ERREUR"
         TxtPassword.Text = ""
         TxtPassword.SetFocus
      End If
End Sub

Private Sub CmdQuitter_Click()
End
End Sub

Private Sub Cmdretourchangementgrid_Click()
    FrmJournalliste.FontItalic = False
    DataGrid2.Visible = False
    DataGrid1.Visible = True
    Cmdretourjournalliste.SetFocus
End Sub

Private Sub Cmdretourchangepassadm_Click()
Frmchangepassadm.Visible = False
    menu.Enabled = False
End Sub

Private Sub Cmdretourcmm_Click()
 FrmCommande.Visible = False
    FrmMain.Visible = True
    CmdEssai.SetFocus
End Sub

Private Sub CmdRetourCopiage_Click()
Frmcopiage.Visible = False
    Frmutilisateur.Visible = True
    CmbUtilisateurs.SetFocus
    menu.Enabled = False
End Sub

Private Sub Cmdretourjournalliste_Click()
    FrmJournalliste.Visible = False
    FrmMain.Visible = True
    CmdEssai.SetFocus
End Sub

Private Sub Cmdretourmotdepassemenu_Click()
Txtmotdepassemenu.Text = ""
    Frmmotdepassemenu.Visible = False
    Frmutilisateur.Visible = True
    menu.Enabled = False
    CmbUtilisateurs.SetFocus
End Sub

Private Sub Cmdretournouveautil_Click()
Frmnouveautil.Visible = False
    menu.Enabled = False
    CmbUtilisateurs.SetFocus
End Sub

Private Sub CmdRetourpassutil_Click()
FrmChangepassutil.Visible = False
    menu.Enabled = False
End Sub

Private Sub Cmdretoursupputil_Click()
    FrmSupputil.Visible = False
    menu.Enabled = False
    CmbUtilisateurs.SetFocus
End Sub

Private Sub Cmdretourzoom_Click()
    FrmZoom.Visible = False
    FrmAffichage.Visible = True
    Cmdsauvgarde.SetFocus
End Sub

Private Sub CmdRetrPass_Click()
FrmSécurit.Visible = False
    FrmMain.Visible = True
    CmdEssai.SetFocus
End Sub

Private Sub Cmdsauvgarde_Click()
    If Not LblAffichage.Caption = "" Then
    With Adojournal.Recordset
             .AddNew
             !Utilisateurs = CmbUtilisateurs.Text
             !numéro_de_commande = TxtNumComm.Text
             !Date = Date
             !Heure = Time
             !tension_desirée = TxtTension.Text
             !tension_obtenue = LblAffichage.Caption
             !Unité = CmbUnité.Text
             If txtremarques.Text = "" Then
                GoTo rienfaire
            Else
             !REMARQUES = txtremarques.Text
            End If
rienfaire:
             .Update
             .Save
             .Requery
    End With
   ' CmdAnnulation.SetFocus
Else
    MsgBox "Patientez S.V.P.", vbCritical, "ERREUR"
    Cmdsauvgarde.SetFocus
End If
End Sub

Private Sub Cmdsortirutil_Click()
End
End Sub

Private Sub CmdSupputil_Click()
    Dim UserName As String
    UserName = lstsupputil.BoundText
    With AdoUtil.Recordset
        If Not .EOF Then
            .MoveFirst
            .Find "Utilisateurs = '" & UserName & "'"
           
            If Not .EOF Then
                .Delete
                .Update
            End If
        Else
            MsgBox "Table vide", vbCritical, "Attention"
        End If
        .Requery
    End With
    lstsupputil.ReFill
End Sub

Private Sub Cmdtriche_Click()
    Frmtriche.Visible = True
    Txtratiotriche.SetFocus
    Txtratiotriche.Text = ""
    FrmAffichage.FontItalic = True
    FrmZoom.FontItalic = True
End Sub

Private Sub Cmdtrichezoom_Click()
    Frmtriche.Visible = True
    Txtratiotriche.SetFocus
    Txtratiotriche.Text = ""
    FrmAffichage.FontItalic = True
    FrmZoom.FontItalic = True
End Sub

Private Sub CmdUtilisateur_Click()
Dim row As Integer
    Dim row1 As Integer
    'chercher le mot de passe correspodant à l'utilisateur choisi
    Dim UserName, Password As String
    UserName = CmbUtilisateurs.BoundText
    If CmbUtilisateurs.Text = "" Then
        MsgBox "Choisir un utilisateur", vbCritical, "Attention"
        CmbUtilisateurs.SetFocus
    Else
         With AdoUtil.Recordset
             .MoveFirst
             .Find "Utilisateurs = '" & UserName & "'"
             Password = !Password
             .Update
         End With
         If Password = TxtPassutilisateur.Text Then
             TxtPassutilisateur.Text = ""
             menu.Enabled = False
             Frmutilisateur.Visible = False
             FrmMain.Visible = True
             CmdEssai.SetFocus
        Else
             MsgBox "Mot de pass invalide", vbCritical, "ERREUR"
             TxtPassutilisateur.Text = ""
             TxtPassutilisateur.SetFocus
         End If
    End If
End Sub

Private Sub CmdZoom_Click()
    FrmAffichage.Visible = False
    FrmZoom.Visible = True
    Cmdretourzoom.SetFocus
End Sub

Private Sub DesactiveationMenu_Click()
    menu.Enabled = False
    CmbUtilisateurs.SetFocus
End Sub

Private Sub Form_Load()
Text1.Visible = False
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
menu.Enabled = False
Form1.Caption = "App2"
With MSComm1
.CommPort = 1 'on utilise le port COM2: car on utilise 1 PC avec 2 ports COM:
'si vous avez 2 PC, changez en .CommPort=1 !!!
.Handshaking = 2
.RThreshold = 1
.RTSEnable = True
.Settings = "9600,n,8,1"
.SThreshold = 1
.PortOpen = True
End With
Text1.Text = ""
Text2.Text = "1"

End Sub

Private Sub Form_Unload(Cancel As Integer)
MSComm1.PortOpen = False 'on ferme le port quand l'appli quitte
End Sub

Private Sub MSComm1_OnComm()
Dim Tampon As String

Select Case MSComm1.CommEvent
' On effectue la gestion des erreurs (cf. le modèle ci-dessus)
' Ici, on gère en fait pas grand-chose, mais c'est pour illustrer la démarche ;)

'liste des erreurs possibles
Case comEventBreak 'On a reçu un signal d’interruption (Break)
Case comEventCDTO ' Timeout de la porteuse
Case comEventCTSTO ' Timeout du signal CTS (Clear To Send)
Case comEventDSRTO ' Timeout du signal de réception
Case comEventFrame ' Erreur de trame
Case comEventOverrun ' Des données ont été perdues
Case comEventRxOver ' Tampon de réception saturé
Case comEventRxParity ' Erreur de parité
Case comEventTxFull ' Tampon d’envoi saturé
Case comEventDCB ' Erreur de réception DCB (jamais vu)

'liste des événements possibles qui sont, eux, normaux
Case comEvCD 'Changement dans la broche CD (porteuse)
Case comEvCTS 'Changement dans broche CTS
Case comEvDSR 'Changement dans broche DSR (réception)
Case comEvRing 'Changement dans broche RING (sonnerie)

'Chouette! on a reçu des données :)
Case comEvReceive
      Tampon = MSComm1.Input
      Call Traitement2(Tampon) 'traitement données
      
Case comEvSend ' il y a des caractères à envoyer

Case comEvEOF 'on a reçu le caractère EOF
End Select
End Sub

Private Sub nouveau_utilisateur_Click()
Frmutilisateur.Visible = True
    Frmnouveautil.Visible = True
    menu.Enabled = False
    Txtnouveautil.SetFocus
End Sub

Private Sub quittermenu_Click()
End
End Sub
Private Sub copiage_Click()
    Frmmotdepassecopiage.Visible = True
    Txtmotdepassecopiage.SetFocus
    menu.Enabled = False
End Sub
Private Sub suprimeutilisateur_Click()
FrmSupputil.Visible = True
    menu.Enabled = False
End Sub

Sub Traitement2(chaine As String)
    Text1.SelStart = Len(Text1.Text)
     Text1.SelText = chaine
   
     valaffiche = chaine 'ici, on affiche le résultat dans un champ de texte
    
reread:
k = k + 1

Dim b As Double
Dim coef As Double
 Dim g As Double
 Dim X As Double
 Dim z As Double 'variable pour essai

 z = valaffiche
 
    Select Case z
   Case 6 To 232
       b = (0.022857 * (z - 5))

   Case 232 To 455
       g = 5.28
       coef = 0.023125
       X = z - 231
       b = g + (coef * X)
  
   Case 456 To 679
       g = 10.46
       coef = 0.023125
       X = z - 455
       b = g + (coef * X)
      
     Case 680 To 903
       g = 15.64
       coef = 0.022946
       X = z - 679
       b = g + (coef * X)
      
     Case 904 To 1129
       g = 20.78
       coef = 0.023053
       X = z - 903
       b = g + (coef * X)
      
     Case 1130 To 1355
       g = 25.99
       coef = 0.02292
       X = z - 1129
       b = g + (coef * X)
      
     Case 1356 To 1577
       g = 31.17
       coef = 0.023258
       X = z - 1356
       b = g + (coef * X)
      
       Case 1578 To 1805
       g = 36.31
       coef = 0.0225
       X = z - 1577
       b = g + (coef * X)
      
       Case 1806 To 2030
       g = 41.44
       coef = 0.022756
       X = z - 1805
       b = g + (coef * X)
      
       Case 2031 To 2500
       g = 46.56
       coef = 0.022632
       X = z - 2030
       b = g + (coef * X)
End Select
       
  
     
continue2:

'    'affichage de la force presente données par le capteur
' en tenant compte de changement d'affichage possible
If CmbUnité.ListIndex = 1 Then   'TF

b = Format(b, "0.00")    If Txtratiotriche.Text "" Or Txtratiotriche.Text "0" Or Txtratiotriche.Text = "00" Then
        Lblvalaffichertf.Caption = (b) ' un label placé a coté des timer qui sert à stabiliser l'affichage en gardant ces valeurs en tf meme en cas de trichage
        LblAffichage.Caption = (b)
        LblZoom.Caption = (b)
    Else
        Lblvalaffichertf.Caption = (b)
        LblAffichage.Caption = (Lblvalaffichertf + (Lblvalaffichertf * Txtratiotriche.Text / 100))
        LblZoom.Caption = (Lblvalaffichertf + (Lblvalaffichertf * Txtratiotriche.Text / 100))
    End If
End If
If CmbUnité.ListIndex = 0 Then ' KN
a = b * 9.81
a = Format(a, "0.0")    If Txtratiotriche.Text "" Or Txtratiotriche.Text "0" Or Txtratiotriche.Text = "00" Then
        Lblvalaffichertf.Caption = (a)
        LblAffichage.Caption = (a)
        LblZoom.Caption = (a)
    Else
        Lblvalaffichertf.Caption = (a)
        LblAffichage.Caption = CInt((Lblvalaffichertf) + ((Lblvalaffichertf) * Txtratiotriche.Text / 100))
        LblZoom.Caption = CInt((Lblvalaffichertf) + ((Lblvalaffichertf) * Txtratiotriche.Text / 100))
    End If
End If

 If z > 2300 Then 'valeur max pour stop machine
  
   MSComm1.Output = Text2.Text
  
  
   End If

'changement de couleur de fond d'ecran quand on atteint la tension max.
If Not TxtTension.Text = "" Then
 
    If CmbUnité.ListIndex = 1 Then  ' TF
        If LblAffichage.Caption > (TxtTension.Text - (TxtTension.Text / 100)) Then
            LblAffichage.ForeColor = 0
            LblAffichage.BackColor = &HFF&
            LblZoom.ForeColor = 0
            LblZoom.BackColor = &HFF&
        Else
            LblAffichage.ForeColor = &H80000002
            LblAffichage.BackColor = &HFF00&
            LblZoom.ForeColor = &H80000002
            LblZoom.BackColor = &HFF00&
            GoTo vide
        End If
    End If
    If CmbUnité.ListIndex = 0 Then 'KN
        If ((LblAffichage.Caption) >= (TxtTension.Text - (TxtTension.Text / 100))) Then
            LblAffichage.ForeColor = 0
            LblAffichage.BackColor = &HFF&
            LblZoom.ForeColor = 0
            LblZoom.BackColor = &HFF&
        Else
            LblAffichage.ForeColor = &H80000002
            LblAffichage.BackColor = &HFF00&
            LblZoom.ForeColor = &H80000002
            LblZoom.BackColor = &HFF00&
            GoTo vide
        End If
    End If
   
Else
    GoTo vide
End If

'sauveguarde auto à la val max.
Dim valmax As Integer
If j <> 1 Then
If LblAffichage.Caption > TxtTension.Text Then
    With Adojournal.Recordset
             .AddNew
             !Utilisateurs = CmbUtilisateurs.Text
             !numéro_de_commande = TxtNumComm.Text
             !Date = Date
             !Heure = Time
             !tension_desirée = TxtTension.Text
             !tension_obtenue = LblAffichage.Caption
             !Unité = CmbUnité.Text
             If txtremarques.Text = "" Then
                GoTo rienfaire
            Else
             !REMARQUES = txtremarques.Text
            End If
rienfaire:
             .Update
             .Save
             .Requery
    End With
   ' If FrmAffichage.Visible = True Then CmdAnnulation.SetFocus
   
    Timer3.Enabled = True
    j = 1
End If
End If

'si dans 40 sec la val de la force augmente, elle remplace l'ancienne valeur

If (i <> 0) And (i Mod 40 = 0) Then
    With Adojournal.Recordset
        .MoveLast
        valmax = !tension_obtenue
   End With
    If LblAffichage.Caption > valmax Then j = 2
 End If
       
vide:
Timer1.Enabled = True
End Sub

Private Sub Timer3_Timer()
 i = i + 1
End Sub

Private Sub Timer1_Timer()
On Error Resume Next
    LblTime.Caption = Date & "    " & Time
End Sub

Private Sub Txtchangepassadm1_KeyPress(KeyAscii As Integer)

    If KeyAscii = 13 Then
        With AdoAdm.Recordset
               .MoveFirst
               '.Find "administrateur"
                passadm = !passadm
        End With
        If Txtchangepassadm1.Text = passadm Then
           Txtchangepassadm2.SetFocus
        Else
           MsgBox "Retappez votre mot de passe", vbOKOnly, "ERREUR DE SAISIE"
           Txtchangepassadm1.Text = ""
           Txtchangepassadm1.SetFocus
        End If
   
    End If

End Sub

Private Sub Txtchangepassadm2_KeyPress(KeyAscii As Integer)

     If Not Txtchangepassadm1 = "" Then
         If KeyAscii = 13 Then
            Txtchangepassadm3.SetFocus
        End If
    End If
End Sub

Private Sub Txtchangepassadm3_KeyPress(KeyAscii As Integer)

    If KeyAscii = 13 Then
        If Txtchangepassadm3.Text = Txtchangepassadm2.Text Then
            Cmdchangepassadm.SetFocus
        Else
            MsgBox "Retappez votre nouveau mot de passe", vbOKOnly, "ERREUR"
            Txtchangepassadm2.Text = ""
            Txtchangepassadm3.Text = ""
            Txtchangepassadm2.SetFocus
        End If
    End If

End Sub

Private Sub TxtChangepassutil_KeyPress(KeyAscii As Integer)
    If (KeyAscii >0) And (KeyAscii < 256) Or (KeyAscii 13) Or (KeyAscii = 8) Then
           If KeyAscii = 13 Then
                CmdChangepassutil.SetFocus
            End If
    End If

End Sub

Private Sub Txtcherchenumcommandejournalliste_KeyPress(KeyAscii As Integer)If (KeyAscii >0) And (KeyAscii < 256) Or (KeyAscii 13) Or (KeyAscii = 8) Then
           If KeyAscii = 13 Then
           Cmdcherchenumcommandejournalliste.SetFocus
            With Adojournal.Recordset
                .MoveFirst
                .Find "numéro_de_commande = '" & Txtcherchenumcommandejournalliste.Text & "'"
            End With
            DataGrid1.RecordSelectors = True
            Txtcherchenumcommandejournalliste.Text = ""
            End If
        End If
End Sub

Private Sub Txtmotdepassecopiage_KeyPress(KeyAscii As Integer)
     Dim passwadm As String     If (KeyAscii >0) And (KeyAscii < 256) Or (KeyAscii 13) Or (KeyAscii = 8) Then
           If KeyAscii = 13 Then
               
                With AdoAdm.Recordset
                    .MoveFirst
                    '.trouver "administrateur"
                    passwadm = !passadm
                End With
                'copiage du journal sur une disquette
                If Txtmotdepassecopiage.Text = passwadm Then
                   Frmmotdepassecopiage.Visible = False
                    Frmutilisateur.Visible = False
                    FrmMain.Visible = False
                    Frmcopiage.Visible = True
                    CmdCopiage.SetFocus
                    menu.Enabled = False
                    Txtmotdepassecopiage.Text = ""
                Else
                    Txtmotdepassecopiage.Text = ""
                End If
            End If
    End If

End Sub

Private Sub Txtmotdepassemenu_KeyPress(KeyAscii As Integer)
    Dim passwadm As String     If (KeyAscii >0) And (KeyAscii < 256) Or (KeyAscii 13) Or (KeyAscii = 8) Then
           If KeyAscii = 13 Then
               
                With AdoAdm.Recordset
                    .MoveFirst
                    '.trouver "administrateur"
                    passwadm = !passadm
                End With
                'copiage du journal sur une disquette
                If Txtmotdepassemenu.Text = passwadm Then
                   menu.Enabled = True
                   Frmutilisateur.Visible = True
                   Txtmotdepassemenu.Text = ""
                   Frmmotdepassemenu.Visible = False
                Else
                    Txtmotdepassemenu.Text = ""
                End If
            End If
    End If

End Sub

Private Sub Txtnouveautil_KeyPress(KeyAscii As Integer)
    If (KeyAscii >0) And (KeyAscii < 256) Or (KeyAscii 13) Or (KeyAscii = 8) Then
           If KeyAscii = 13 Then
                Txtnouveautilpass.SetFocus
           End If
    End If

End Sub

Private Sub Txtnouveautilpass_KeyPress(KeyAscii As Integer)
    If (KeyAscii >0) And (KeyAscii < 256) Or (KeyAscii 13) Or (KeyAscii = 8) Then
           If KeyAscii = 13 Then
                Cmdnouveautil.SetFocus
            End If
    End If

End Sub

Private Sub TxtNumComm_KeyPress(KeyAscii As Integer)
    If (KeyAscii >0) And (KeyAscii < 256) Or (KeyAscii 13) Or (KeyAscii = 8) Then
        If KeyAscii = 13 Then
            CmbUnité.SetFocus
        End If
    Else
        KeyAscii = 0
    End If

End Sub

Private Sub TxtPassutilisateur_KeyPress(KeyAscii As Integer)
    If (KeyAscii >0) And (KeyAscii < 256) Or (KeyAscii 13) Or (KeyAscii = 8) Then
  
        If KeyAscii = 13 Then
           
            Dim row As Integer
            Dim row1 As Integer
            Dim UserName, Password As String
            UserName = CmbUtilisateurs.BoundText
            If CmbUtilisateurs.Text = "" Then
             MsgBox "Choisir un utilisateur", vbCritical, "Attention"
             CmbUtilisateurs.SetFocus
            Else
             With AdoUtil.Recordset
                 .MoveFirst
                 .Find "Utilisateurs = '" & UserName & "'"
                 Password = !Password
             End With
             If Password = TxtPassutilisateur.Text Then
                 TxtPassutilisateur.Text = ""
                 menu.Enabled = False
                 Frmutilisateur.Visible = False
                 FrmMain.Visible = True
                 CmdEssai.SetFocus
             Else
                 MsgBox "Mot de pass invalide", vbCritical, "ERREUR"
                 TxtPassutilisateur.Text = ""
                 TxtPassutilisateur.SetFocus
            End If
        End If
   
         End If
     Else
             KeyAscii = 0
     End If

End Sub

Private Sub TxtPassword_KeyPress(KeyAscii As Integer)
    If (KeyAscii >0) And (KeyAscii < 256) Or (KeyAscii 13) Or (KeyAscii = 8) Then
        If KeyAscii = 13 Then
            With AdoAdm.Recordset
                .MoveFirst
                '.trouver "administrateur"
                passwadm = !passadm
            End With
            If TxtPassword.Text = passwadm Then
                MsgBox "bien Venu :)", vbOKOnly, "Administrateur"
                TxtPassword.Text = ""
                TxtPassword.Text = ""
                'affichage du journal
                FrmSécurit.Visible = False
                FrmJournalliste.Visible = True
                Cmdretourjournalliste.SetFocus
            Else
                MsgBox "Retapez le mot de passe", vbOKOnly, "ERREUR"
                TxtPassword.Text = ""
                TxtPassword.SetFocus
            End If
        End If
    Else
            KeyAscii = 0
    End If

End Sub

Private Sub Txtratiotriche_keypress(KeyAscii As Integer)   If (KeyAscii >48) And (KeyAscii < 58) Or (KeyAscii 13) Or (KeyAscii = 8) Then
       If KeyAscii = 13 Then
                Frmtriche.Visible = False
                FrmAffichage.FontItalic = False
                FrmZoom.FontItalic = False
               
               If FrmAffichage.Visible = True Then
                    Cmdsauvgarde.SetFocus
               End If
               If FrmZoom.Visible = True Then
                    Cmdretourzoom.SetFocus
               End If
        End If
    Else
        KeyAscii = 0
    End If

End Sub

Private Sub TxtTension_KeyPress(KeyAscii As Integer)
    If (KeyAscii >48) And (KeyAscii < 58) Or (KeyAscii 13) Or (KeyAscii = 8) Then
  
        If KeyAscii = 13 Then
            If CmbUnité.ListIndex = 0 Then
                If TxtTension.Text = "" Then
                    Txtconvertion.Text = ""
                    GoTo llErreur
                End If
                Txtconvertion.Text = TxtTension.Text
            Else
                If TxtTension.Text = "" Then
                    Txtconvertion.Text = ""
                    GoTo llErreur
                End If
                Txtconvertion.Text = TxtTension.Text * 9.81
llErreur:
        End If
            CmdConfComm.SetFocus
        End If
    Else
            KeyAscii = 0
    End If

End Sub
Private Sub Timer4_Timer()
    On Error Resume Next
    LblTime.Caption = Date & "    " & Time
End Sub
0
cs_Nicko11 Messages postés 1141 Date d'inscription mercredi 7 mars 2007 Statut Membre Dernière intervention 19 septembre 2007 3
6 juin 2007 à 08:17
Je vois que tu fais tres souvent référence a AdoAdm mais le truc, c'est que je ne le vois déclaré nul part.

Oublies un peu ton code et essaies deja de te connecter à une base de données et de lire (ou modifier) les données avec le recordset grace au code que je t'ai donné car sinon tu n'avanceras pas.
0