Discussion :

[INCO13]

bonjour,
je m'explique je voudrait modifier une cellule à partir d'un formulaireen fonction de 2 variable
mon code vba et le Suivant:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Private Sub adulte_Change()
If Not IsNumeric(adulte) Then       'si le champ adulte n'est pas numerique alors
reponse = MsgBox("Veuillez indiquer un nombre", vbCritical, "ERREUR") 'affichr un message d'erreur
adulte = Clear                      'effacer le champ  adulte
End If
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Private Sub cp_clt_Change()
If Not IsNumeric(cp_clt) Then       ' si le champs cp_clt est du texte alors
reponse = MsgBox("Veuillez écrire votre code postale correctement svp!", , "ATTENTION") 'afficher un message d'erreur
cp_clt = Clear                'effacer la cellule cp_clt
End If
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Private Sub UserForm_Initialize()
Dim voyage As String, quand As String   'declaration des variables
Dim y As Integer                        'declaration des variables
 
Sheets("bd").Activate                   ' activer la feuille exel bd
y = Sheets("bd").Range("a3").End(xlDown).Offset(0, 0).Row 'mise en forme de la base de donne
destination.RowSource = "a3:a" & y
 
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub destination_Change()
Dim str As String, cel As Range             'declaration des variables
datecmd.Clear                               'effacer le champ datecmd
    str = destination.Value                 'prise de valeur de la variables
    With Worksheets("voyage")               'avec la feuille exel voyage
    For Each cel In .Range("a2:b" & .Range("a" & Rows.Count).End(xlUp).Row) 'chercher que dans la base
        If cel = str Then                   'si la comparaison est la valeur voulu et identique a la valeur trouver alors
            With datecmd                    'dans le champ datecmd ajouter les valeur trouver
              .AddItem cel(1, 2)
            End With                        'fin de l'association
        End If                              'fin de la comparaison
    Next cel                                'suivant cellule
    End With                                'fin de l'association
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Private Sub enfant_Change()
If Not IsNumeric(enfant) Then       'si le champs enfant n'est pas du numerique alors
reponse = MsgBox("Veuillez indiquer un nombre svp!", , "ATTENTION") And enfant = Clear  'afficher un message d'erreur
enfant = Clear                      'effacer le champ enfant
End If
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Private Sub nom_clt_Change()
If IsNumeric(nom_clt) Then          'si le champ nom_clt est du numerique alors
reponse = MsgBox("Veuillez écrire votre nom correctement svp!", , "ATTENTION")  ' afficher un message d'erreur
nom_clt = Clear                     ' effacer le champ nom_clt
End If
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Private Sub nourisson_Change()
If Not IsNumeric(nourisson) Then     'si le champ nourisson n'est pas du texte alors
reponse = MsgBox("Veuillez indiquer un nombre svp!", , "ATTENTION")  ' afficher un message d'erreur
nourisson = Clear                    'affecer le champ nourisson
End If
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Private Sub prenom_clt_Change()
If IsNumeric(prenom_clt) Then       'si le champ prenom_clt est du numerique alors
reponse = MsgBox("Veuillez écrire votre prenom correctement svp!", , "ATTENTION") 'afficher message d'erreur
prenom_clt = Clear                  'effacer le champ prenom_clt
End If
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Private Sub userform_activate()
Worksheets("client").Activate           'active la feuille exel client
client!nom_clt.SetFocus                 'met le focus sur le nom client
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Private Sub annuler_Click()
reponse = MsgBox("Voulez Vous vraiment quitter?", vbYesNo, "QUITTER") 'message si vous voulez quiter le formulaire
If vbYesNo = oui Then                   ' si oui alors
 
 Range("nom_clt").Clear                 'efface les données entrées
 Range("adresse_clt").Clear
 Range("prenom_clt").Clear
 Range("cp_clt").Clear
 Range("ville_clt").Clear
 Range("classe").Clear
 Range("destination").Clear
 Range("datecmd").Clear
 Range("adulte").Clear
 Range("enfant").Clear
 Range("nourisson").Clear
  Unload client                         'sortir du formulaire
  Else                                  'sinon rien
  End If                                'fin de la condition
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Private Sub valider_click()
nom_clt.SetFocus                        'clignotemet au niveau du nom
If nom_clt = "" Or prenom_clt = "" Or _
adresse_clt = "" Or cp_clt = "" Or _
ville_clt = "" Or classe = "" Or _
destination = "" Or datecmd = "" Or adulte = "" Or _
nourisson = "" Or enfant = "" Then      ' verifie si les champs ne sont pas vide
 
  reponse = MsgBox("Vous n'avez pas remplis certaines informations!", _
  vbCritical, "ATTENTION")              ' si c le cas message d'erreur
 ElseIf nom_clt <> "" And prenom_clt <> "" _
 And adresse_clt <> "" And cp_clt <> "" _
 And ville_clt <> "" And destination <> "" _
 And datecmd <> "" And classe <> "" And adulte <> "" _
 And nourisson <> "" And enfant <> "" Then ' verifie si les champs sont complets alors
 ligne = Cells(Rows.Count, "A").End(xlUp).Row + 1 'regarde dans la base le nombre de celule complete puis ajoute 1 a ligne
 
 Range("A" & ligne) = nom_clt           'rentre les informations dans les celules vec le n°de olones et de lignes
 Range("B" & ligne) = prenom_clt
 Range("C" & ligne) = adresse_clt
 Range("D" & ligne) = cp_clt
 Range("E" & ligne) = ville_clt
 Range("F" & ligne) = destination
 Range("G" & ligne) = datecmd
 Range("H" & ligne) = classe
 Range("I" & ligne) = adulte
 Range("J" & ligne) = enfant
 Range("K" & ligne) = nourisson
 End If
 
client.Hide                             'ferme le formulaire client
End Sub

ce que je cherche a faire c'est afficher quand je s'electionne une destination et une date dans les liste deroulantes que s'a mafiche un message qui m'indique combien il reste dans les cellule eco, affaire et premiere de ma base de donnesdans 1 premiere parti
et dans une seconde parti sa impute la valeur de mes champ a la base de donnée.si vous vouler je peut vous envoyer mon programme.
merci

[mayekeul]

bonjour,

et dans une seconde parti sa impute la valeur de mes champ a la base de donnée.si vous vouler je peut vous envoyer mon programme.

en fonction de quoi?

si vous vouler je peut vous envoyer mon programme.

ok

[INCO13]

merci d'avoir repondu.
sa doit inputer dans la table voyage au nombre deja inscrit en fonction du nombre saisi dans le formulaire au niveau de eco premiere affaire.
en esperant que cela puisse vous aidez, merci

[mayekeul]

afficher quand je s'electionne une destination et une date dans les liste deroulantes que s'a mafiche un message qui m'indique combien il reste dans les cellule eco, affaire et premiere de ma base de donnesdans

c'est assez nébuleux

mais bon le princie est le suivant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
sub destination_change()
if not datecmd="" then
    affichereste
end if

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
sub datecmd_change()
if notdestination="" then affichereste

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
sub affichereste
'alors on doit afficher quoi?
'le reste de quoi
'par rapport a quoi?
end sub

[INCO13]

'alors on doit afficher quoi?
'le reste de quoi
'par rapport a quoi?


un message qui m'indique le nombre de place qui reste dans les differentes categories ( eco , premiere , affaire ) .qui se trouve sur la page voyage
si il ne reste plus de place sa m'afiche un message d'erreur

et dans une seconde partie.quand je cliquerait sur le bouton ok il faudrait que je crai une macro sui retourne dans la feuille voyage et que sa me supprime(enleve) les valeurs dans les champs correspondant(a la fois au voyage , a la date et au differentes categories (eco affaires et premieres

[mayekeul]

tu peux t'inspirer de ça si tu veux!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Dim SoldeEco As Integer
Dim SoldeAffaire As Integer
Dim SoldePremiere As Integer
Dim strEco As String
Dim strAffaire As String
Dim strPremiere As String
 
'récupérer le solde des voyage pour la classe choisie
With Sheets("voyage")
    Do Until .Cells(i, 1) = ""
        If .Cells(i, 1) = destination.Value Then
            SoldeEco = SoldeEco + .Cells(i, 4)
            SoldeAffaire = SoldeAffaire + .Cells(i, 5)
            SoldePremiere = SoldePremiere + .Cells(i, 6)
        End If
    Loop
End With
 
'afficher solde
strEco = "Places eco restantes : " & SoldeEco & vbCr
strAffaire = "Places affaires restantes : " & SoldeAffaire & vbCr
strPremiere = "Places premières restantes : " & SoldePremiere & vbCr
MsgBox strEco & strAffaire & strPremiere

[INCO13]

tout d'abord merci pour ce code .
je voudrait juste savoir commen je peut l'imbriquer dans le mien j'est essayer plusieur facon mais sa me fait beuger le programme.

[mayekeul]

c'est a dire?

[INCO13]

je voudrait connaitre l'endroit dans ma progamation je doit inscrire ce code.

[mayekeul]

je te l'ai montré plus haut
le code ici est une procedure complete

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 
sub AfficheReste
Dim SoldeEco As Integer
Dim SoldeAffaire As Integer
Dim SoldePremiere As Integer
Dim strEco As String
Dim strAffaire As String
Dim strPremiere As String
 
'récupérer le solde des voyage pour la classe choisie
With Sheets("voyage")
    Do Until .Cells(i, 1) = ""
        If .Cells(i, 1) = destination.Value Then
            SoldeEco = SoldeEco + .Cells(i, 4)
            SoldeAffaire = SoldeAffaire + .Cells(i, 5)
            SoldePremiere = SoldePremiere + .Cells(i, 6)
        End If
    Loop
End With
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
sub destination_change()
...
if not datecmd="" then
    affichereste
end if
...
end sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
sub datecmd_change()
...
if notdestination="" then affichereste 
...
end sub

[INCO13]

j'ai fait ce que tu m'avait proposer de faire mais sa ne marche toujour pas.
il y a toujour un message d'erreur , je commprnd pas pk .

[mayekeul]

oui c'est de ma faute, je me suispas relu
j'avais oublié l'incrémentation

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub affichereste()
Dim SoldeEco As Integer
Dim SoldeAffaire As Integer
Dim SoldePremiere As Integer
Dim strEco As String
Dim strAffaire As String
Dim strPremiere As String
 
'récupérer le solde des voyage pour la classe choisie
With Sheets("voyage")
    i = 1
    Do Until .Cells(i, 1) = ""
        If .Cells(i, 1) = destination.Value Then
            SoldeEco = SoldeEco + .Cells(i, 4)
            SoldeAffaire = SoldeAffaire + .Cells(i, 5)
            SoldePremiere = SoldePremiere + .Cells(i, 6)
        End If
        i = i + 1
    Loop
End With
 
'afficher solde
strEco = "Places eco restantes : " & SoldeEco & vbCr
strAffaire = "Places affaires restantes : " & SoldeAffaire & vbCr
strPremiere = "Places premières restantes : " & SoldePremiere & vbCr
MsgBox strEco & strAffaire & strPremiere
End Sub

[INCO13]

je te remerci sa fonctionne.
et une derniere chose commen je pourait deduire dans la table voyage, la valeur que j'ai saisie dans les champs eco affaire et premiere en respectant bien la destination et la date.

[mayekeul]

de la même maniere que je viens de te montrer, il te suffit juste d'ajouter la date et la désignation

un peu comme ça

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
...
    select case classe
        case "eco":j=4
        case "affaire":j=5
        case "premiere":j=6
    end select
    Do Until .Cells(i, 1) = ""
        If .Cells(i, 1) = destination.Value and cells(i,2)=cmdate Then
            cells(i,j)=cells(i,j)-adulte-enfant-nourrisson
        End If
        i = i + 1
    Loop
...

[INCO13]

es ce que je peut le faire rentrer dans le code du bouton "ok " pour que quand je clique ok les places se déduise.

[mayekeul]

mais bien evidemment!

:-)

[INCO13]

salut ,
j'aurai besoin de toi une derniere fois j'ai essayer de mettrele code sur le bouton ok de mettre l'incrementation mais sa ne marche toujour pas l'incremantation code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
'ACTIVER LE BOUTTON VALIDER
Private Sub valider_click()
nom_clt.SetFocus                        'clignotemet au niveau du nom
If nom_clt = "" Or prenom_clt = "" Or _
adresse_clt = "" Or cp_clt = "" Or _
ville_clt = "" Or classe = "" Or _
destination = "" Or datecmd = "" Or adulte = "" Or _
nourisson = "" Or enfant = "" Then      ' verifie si les champs ne sont pas vide

  reponse = MsgBox("Vous n'avez pas remplis certaines informations!", _
  vbCritical, "ATTENTION")              ' si c le cas message d'erreur
 ElseIf nom_clt <> "" And prenom_clt <> "" _
 And adresse_clt <> "" And cp_clt <> "" _
 And ville_clt <> "" And destination <> "" _
 And datecmd <> "" And classe <> "" And adulte <> "" _
 And nourisson <> "" And enfant <> "" Then ' verifie si les champs sont complets alors
 ligne = Cells(Rows.Count, "A").End(xlUp).Row + 1 'regarde dans la base le nombre de celule complete puis ajoute 1 a ligne
 
 Range("A" & ligne) = nom_clt           'rentre les informations dans les celules vec le n°de olones et de lignes
 Range("B" & ligne) = prenom_clt
 Range("C" & ligne) = adresse_clt
 Range("D" & ligne) = cp_clt
 Range("E" & ligne) = ville_clt
 Range("F" & ligne) = destination
 Range("G" & ligne) = datecmd
 Range("H" & ligne) = classe
 Range("I" & ligne) = adulte
 Range("J" & ligne) = enfant
 Range("K" & ligne) = nourisson
 End If
 
With Sheets("voyage")
Select Case classe
        Case "eco": j = 4
        Case "affaire": j = 5
        Case "premiere": j = 6
    End Select
    i = 1
    Do Until .Cells(i, 1) = ""
        If .Cells(i, 1) = destination.Value And Cells(i, 2) = cmdate Then
            Cells(i, j) = Cells(i, j) - adulte - enfant - nourrisson 'il mindique l'erreur ici         End If
        i = i + 1
    Loop
End With
client.Hide                             'ferme le formulaire client
End Sub

en esperant que tu puisse m'apporter une derniere fois ton aide merci.

[mayekeul]

bonjour,

ici a chaud, je dirais que j est égal à zéro

vérifie ton select passe le au pas à pas pour verifier la valeur de j

[INCO13]

franchement désoler de te gener avec sa,
il est clair que le message d'erreur ne s'affiche plus ,
mais il n'y a aucune soutraction a la base de donne c'est comme si le code ne servait a rien se doit probablement etre de ma faute, j'ai du toucher un truc qui ne fallait pas voici mon code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
Private Sub valider_click()
nom_clt.SetFocus                        'clignotemet au niveau du nom
If nom_clt = "" Or prenom_clt = "" Or _
adresse_clt = "" Or cp_clt = "" Or _
ville_clt = "" Or classe = "" Or _
destination = "" Or datecmd = "" Or adulte = "" Or _
nourisson = "" Or enfant = "" Then      ' verifie si les champs ne sont pas vide
 
  reponse = MsgBox("Vous n'avez pas remplis certaines informations!", _
  vbCritical, "ATTENTION")              ' si c le cas message d'erreur
 ElseIf nom_clt <> "" And prenom_clt <> "" _
 And adresse_clt <> "" And cp_clt <> "" _
 And ville_clt <> "" And destination <> "" _
 And datecmd <> "" And classe <> "" And adulte <> "" _
 And nourisson <> "" And enfant <> "" Then ' verifie si les champs sont complets alors
 ligne = Cells(Rows.Count, "A").End(xlUp).Row + 1 'regarde dans la base le nombre de celule complete puis ajoute 1 a ligne
 
 Range("A" & ligne) = nom_clt           'rentre les informations dans les celules vec le n°de olones et de lignes
 Range("B" & ligne) = prenom_clt
 Range("C" & ligne) = adresse_clt
 Range("D" & ligne) = cp_clt
 Range("E" & ligne) = ville_clt
 Range("F" & ligne) = destination
 Range("G" & ligne) = datecmd
 Range("H" & ligne) = classe
 Range("I" & ligne) = adulte
 Range("J" & ligne) = enfant
 Range("K" & ligne) = nourisson
 End If
 
   With Sheets("voyage")
j = 0
Select Case classe
        Case "eco": j = 4
        Case "affaire": j = 5
        Case "premiere": j = 6
    End Select
 
 
    i = 1
    Do Until .Cells(i, 1) = ""
        If .Cells(i, 1) = destination.Value And Cells(i, 2) = cmdate Then
            Cells(i, j) = Cells(i, j) - adulte - enfant - nourrisson
        End If
        i = i + 1
    Loop
End With
client.Hide                             'ferme le formulaire client
End Sub

il n'y a plus de messag d'erreur ni de beug mais y a rien qui ce soustrait .

[mayekeul]

lol
ne t'inquietes pas, il n'y a pas de soucis.

apparemment tu as oublié certains points, donc il comparait des valeurs dans le feuille active en lieu et place de la feuille voyage

essaye comme ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
With Sheets("voyage")
    J = 0
    Select Case classe
        Case "eco": J = 4
        Case "affaire": J = 5
        Case "premiere": J = 6
    End Select
    I = 1
    Do Until .Cells(I, 1) = ""
        If .Cells(I, 1) = Destination.Value And .Cells(I, 2) = cmdate Then
            .Cells(I, J) = .Cells(I, J) - adulte - enfant - nourrisson
        End If
        I = I + 1
    Loop
End With