Sujet Précédent Sujet Suivant

Probleme inscription valeur dans deux tableu diferent

Fermé
cedric0715 Messages postés 210 Date d'inscription mercredi 25 février 2015 Statut Membre Dernière intervention 6 mai 2018 - 26 déc. 2016 à 11:19
yg_be Messages postés 22891 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 16 juin 2024 - 5 janv. 2017 à 16:13
Bonjour,

j ai un problème dans l'inscription de mon résultat , des lors que ma note est supérieur a l’année précédente et que mon checkbox n'est pas cocher cela supprime bien ma ligne dans mon tableau Recap mais cela change ma note "tableau donne équipement "ce que je ne veux pas " et je n arrive pas du tout a résoudre mon problème
je ne vois pas ou est mon erreur
merci de votre aide
j ai 3 conditions voir le code ci dessous de plus je mets le fichiers
https://mon-partage.fr/f/Os7FQmZp/

je souhaite a toutes et tous sur le forum de passe de bonne fête
encore merci a tous de nous aidez 

'enregistrement et protection blocage des donnees'

Private Sub CommandButton1_Click()


Dim l_info As Integer
Dim L As Integer
Dim note_1 As String, note_2 As String, lanote As String
Dim ws As Worksheet
Dim ds As Worksheet
'protection feuille
Dim cell As Range
                Dim pl As Range
                Worksheets("TABLEAU RECAP").Visible = True
                Worksheets("TABLEAU RECAP").Unprotect ("cedric")
                Sheets("TABLEAU RECAP").Cells.Locked = True
                For Each cell In Sheets("TABLEAU RECAP").Range("M2")
                    If cell.MergeCells = True Then
                        Set pl = cell.MergeArea
                        cell.UnMerge
                        cell.Locked = False
                        pl.Merge
                    Else
                        cell.Locked = False
                    End If
                Next cell
                Worksheets("TABLEAU RECAP").Protect ("cedric"), DrawingObjects:=True, Contents:=True, Scenarios:=True, UserInterfaceOnly:=True


With ThisWorkbook.Worksheets("TABLEAU RECAP")
 l_info = .Cells(.Rows.Count, 2).End(xlUp).Row + 1


     .Range("B" & l_info).Value = ComEQUI 'libelle equipement'
        .Range("c" & l_info).Value = Textlocal 'code local"
        .Range("D" & l_info).Value = ComRESP 'Nom du responsable'
        .Range("E" & l_info).Value = CDate(TextDATEAM) 'date du constat'
        .Range("F" & l_info).Value = CDate(TextMISE) 'date de mise en service'
        .Range("G" & l_info).Value = CInt(TextDUREVIE.Value)  'Duree de vie theorique'
        .Range("H" & l_info).Value = CDate(TextREMPL) 'Date theorique de remplacement '
        .Range("I" & l_info).Value = CInt(TextDURVIERESI.Value)  'Duree de vie residuelle '
        .Range("J" & l_info).Value = TextESTIMREMPL 'Duree de vie residuelle '
        .Range("K" & l_info).Value = CInt(TextRESUETAT.Value) 'note de etat equipement'
        .Range("l" & l_info).Value = CInt(TextRESUCRIT.Value) 'note de criticite equipement'
        .Range("t" & l_info).Value = "cliquer pour validation"



If CheckBox1.Value Then
'cas case cochee
.Range("p" & l_info).Value = "x"
.Range("q" & l_info).Value = CDate(Textboxdatechange) 'date de remplacement équipement
MsgBox ("attention imformer au equipe gmao le changement de l'equipement")
Else
'cas case non cochee
'rien ?
End If

 If UserFormpri.CheckBox1.Value = True Then
 userform2.TextBox6.Value = Me.ComEQUI.Value  'colle valeur équipement dans le texbox de l'uesrform2 et l'appeler
 userform2.Show
 Else
'rien
End If


With .Range("M" & l_info)
                'formulation
                .FormulaR1C1 = "=IF(RC[-2]<=21,""Mauvais"",IF(RC[-2]<=43,""Usuel"",IF(RC[-2]<=64,""Bon"")))"
                'équivaut à un collage spécial valeur
                .Value = .Value
                note_1 = .Value
         End With

         With .Range("N" & l_info)
                'formulation
                .FormulaR1C1 = "=IF(RC[-2]<=21,""Faible"",IF(RC[-2]<=43,""Moyenne"",IF(RC[-2]<=64,""Forte"")))"
                'équivaut à un collage spécial valeur
                .Value = .Value
                note_2 = .Value
         End With

        Select Case True
                    Case note_1 = "Mauvais" And note_2 = "Faible"
                            lanote = "B"
                    Case note_1 = "Mauvais" And note_2 = "Moyenne"
                            lanote = "C"
                    Case note_1 = "Mauvais" And note_2 = "Forte"
                            lanote = "C"

                     Case note_1 = "Usuel" And note_2 = "Faible"
                            lanote = "A"
                    Case note_1 = "Usuel" And note_2 = "Moyenne"
                            lanote = "B"
                    Case note_1 = "Usuel" And note_2 = "Forte"
                            lanote = "B"

                     Case note_1 = "Bon" And note_2 = "Faible"
                            lanote = "A"
                    Case note_1 = "Bon" And note_2 = "Moyenne"
                            lanote = "A"
                    Case note_1 = "Bon" And note_2 = "Forte"
                            lanote = "A"

        End Select


.Range("O" & l_info).Value = lanote 'donne de la note dans le tableau recap

'si mon chexbox est cocher et que la note est superieur a l'annee d'avant message et fermeture de userform et sans validation dans le tableau recap

Set ds = ThisWorkbook.Worksheets("Donnée équipement")
 L = ds.Cells.Find(ComEQUI.Value, , , xlWhole).Row
 ds.Range("G" & L).Value = lanote

Set ws = ThisWorkbook.Worksheets("TABLEAU RECAP")
l_info = ws.Cells.Find(ComEQUI.Value, , , xlWhole).Row
If ws.Range("O" & l_info).Value > lanote And CheckBox1.Value = False Then
If MsgBox("Note différente de l'année dernière", vbOK Or vbCancel) = vbOK Or vbCancel Then
Sheets("TABLEAU RECAP").Range("b" & Sheets("TABLEAU RECAP").Range("b65000").End(xlUp).Row).EntireRow.ClearContents
  MsgBox ("Recommencer l'evaluation")

   End If

   Set ds = ThisWorkbook.Worksheets("Donnée équipement")
 L = ds.Cells.Find(ComEQUI.Value, , , xlWhole).Row
If ds.Range("G" & L).Value = lanote = lanote And CheckBox1.Value = False Then
ds.Range("G" & L).Value = lanote

End If


Set ds = ThisWorkbook.Worksheets("Donnée équipement")
 L = ds.Cells.Find(ComEQUI.Value, , , xlWhole).Row  'si la note est inferieur a la donne de G "donne equipement" et chexbox pas coché rien faire
 If ds.Range("G" & L).Value < lanote And CheckBox1.Value = False Then

  End If

Set ds = ThisWorkbook.Worksheets("Donnée équipement")
 L = ds.Cells.Find(ComEQUI.Value, , , xlWhole).Row  'si la note est superieur  a la donne dans G "donnée equipement" et chexbox coché message et inscription de la nouvelle note
 If ds.Range("G" & L).Value < lanote And CheckBox1.Value = True Then
 ds.Range("G" & L).Value = lanote

     End If


End If

 End With


Me.hide

Unload UserFormpri



End Sub




'saisie des options'


Private Sub OptionButton1_Change()
    Call note_etat
End Sub
Private Sub OptionButton2_Change()
    Call note_etat
End Sub
Private Sub OptionButton3_Change()
    Call note_etat
End Sub
Private Sub OptionButton4_Change()
    Call note_etat
End Sub
Private Sub OptionButton5_Change()
    Call note_etat
End Sub
Private Sub OptionButton6_Change()
    Call note_etat
End Sub
Private Sub OptionButton7_Change()
    Call note_etat
End Sub
Private Sub OptionButton8_Change()
    Call note_etat
End Sub
Private Sub OptionButton9_Change()
    Call note_etat
End Sub
Private Sub OptionButton10_Change()
    Call note_etat
End Sub
Private Sub OptionButton11_Change()
    Call note_etat
End Sub
Private Sub OptionButton12_Change()
    Call note_etat
End Sub
Private Sub OptionButton13_Change()
    Call note_crit
End Sub
Private Sub OptionButton14_Change()
    Call note_crit
End Sub
Private Sub OptionButton15_Change()
    Call note_crit
End Sub
Private Sub OptionButton16_Change()
    Call note_crit
End Sub
Private Sub OptionButton17_Change()
    Call note_crit
End Sub
Private Sub OptionButton18_Change()
    Call note_crit
End Sub
Private Sub OptionButton19_Change()
    Call note_crit
End Sub
Private Sub OptionButton20_Change()
    Call note_crit
End Sub
Private Sub OptionButton21_Change()
    Call note_crit
End Sub
Private Sub OptionButton22_Change()
    Call note_crit
End Sub
Private Sub OptionButton23_Change()
    Call note_crit
End Sub
Private Sub OptionButton24_Change()
    Call note_crit
End Sub
'calcul des notes'
Private Sub note_etat()
Dim i As Integer, etat1 As Integer, etat2 As Integer, etat3 As Integer

i = 0
etat1 = 0
While i <= 3
    etat1 = etat1 - (i + 1) * CInt(Frame2.Controls(i).Value)
    i = i + 1
Wend
i = 0
etat2 = 0
While i <= 3
    etat2 = etat2 - (i + 1) * CInt(Frame3.Controls(i).Value)
    i = i + 1
Wend
i = 0
etat3 = 0
While i <= 3
    etat3 = etat3 - (i + 1) * CInt(Frame4.Controls(i).Value)
    i = i + 1
Wend
TextRESUETAT = etat1 * etat2 * etat3
End Sub

Private Sub note_crit()
Dim i As Integer, crit1 As Integer, crit2 As Integer, crit3 As Integer

i = 0
crit1 = 0
While i <= 3
    crit1 = crit1 - (i + 1) * CInt(Frame6.Controls(i).Value)
    i = i + 1
Wend
i = 0
crit2 = 0
While i <= 3
    crit2 = crit2 - (i + 1) * CInt(Frame7.Controls(i).Value)
    i = i + 1
Wend
i = 0
crit3 = 0
While i <= 3
    crit3 = crit3 - (i + 1) * CInt(Frame8.Controls(i).Value)
    i = i + 1
Wend
TextRESUCRIT = crit1 * crit2 * crit3
End Sub



A voir également:

2 réponses

Réponse 1 / 2
cedric0715 Messages postés 210 Date d'inscription mercredi 25 février 2015 Statut Membre Dernière intervention 6 mai 2018
26 déc. 2016 à 14:04
j ai modifier mon code pour les éléments qui irons dans le tableau donné équipement
mais cela ne marche toujours pas (ci dessous mon code) 



Set ws = ThisWorkbook.Worksheets("TABLEAU RECAP")
l_info = ws.Cells.Find(ComEQUI.Value, , , xlWhole).Row
If ws.Range("O" & l_info).Value = "" Then 'donne de la note dans le tableau recap
ws.Range("o" & l_info).Value = lanote
ElseIf ws.Range("O" & l_info).Value > lanote And CheckBox1.Value = False Then
If MsgBox("Note différente de l'année dernière", vbOK) = vbOK Then
Sheets("TABLEAU RECAP").Range("b" & Sheets("TABLEAU RECAP").Range("b65000").End(xlUp).Row).EntireRow.ClearContents
  MsgBox ("Recommencer l'evaluation")

   End If

   Set ds = ThisWorkbook.Worksheets("Donnée équipement")
 L = ds.Cells.Find(ComEQUI.Value, , , xlWhole).Row

If ds.Range("G" & L).Value = lanote = lanote And CheckBox1.Value = False Then
ds.Range("G" & L).Value = lanote

ElseIf ds.Range("G" & L).Value < lanote And CheckBox1.Value = False Then 'si la note est inferieur a la donne de G "donne equipement" et chexbox pas coché rien faire

ElseIf ds.Range("G" & L).Value > lanote And CheckBox1.Value = True Then 'si la note est superieur  a la donne dans G "donnée equipement" et chexbox coché message et inscription de la nouvelle note
ds.Range("G" & L).Value = lanote

Else
ds.Range("G" & L).Value = lanote
  End If


End If


aidez moi merci par avance
0
Réponse 2 / 2
yg_be Messages postés 22891 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 16 juin 2024 1 478
26 déc. 2016 à 20:23
Voilà, j'ai ouvert ton fichier.
Merci d'expliquer ce que je dois faire pour exécuter ton programme, et ce qui ne te conviens pas dans le comportement de ton programme.
0
cedric0715 Messages postés 210 Date d'inscription mercredi 25 février 2015 Statut Membre Dernière intervention 6 mai 2018
27 déc. 2016 à 08:40
les étapes sont les suivante

"tableau recap"
cliker sur nouvelle evaluation , un userform s 'ouvre

attention je n'ai pas encore mis en griser le bouton valider des lors que les champs obligatoire doivent être rempli.

1- choisir un équipement "des tex box se rempli en fonction des "donnée équipement "
2- noter l’équipement a faisant un choix avec les option buttons
3- les deux note donne un lettre A, B OU C lors de la validation
4 mettre la date de l’évaluation
5- choisir la personne qui fait évaluation puis valider

mon probleme se situ la sous 4 conditions
exemple cta n°1

1ere condition la note est A en 2016 après validation les donné vont dans le tableau recap et la lettre va aussi dans la donne équipement en colonne G en face de celui ci .

2emecondition la note est A ,B ou C en 2017 après validation les donné vont dans le tableau recap et la letre va aussi dans la donne équipement en colonne G en face de celui ci .

3 eme condition si la note est B ou C a la première évaluation et que la 2 eme année elle est A et que dans l'userfom la case équipement change n est pas coche cela appel un message box efface la ligne (cela sa marche) mais la note dans donnée équipement ne doit pas changé et cela ne marche pas

4 eme condition si la note est B ou C a la première évaluation et que la 2 eme année elle est A et que dans l'userfom la case équipement changé est coche il faut remplir la date cela appel un message box puis un userform pour remplir le nouveaux modèle d’Équipement et donc après validation les éléments sont remplis dans le tableau recap change la note dans la donne équipement en colonne G
ET après il y a un circuit de c validation qui se fait dans le tableau recap

j espère que tu a compris
merci encore de ton aide
cordialement
0
yg_be Messages postés 22891 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 16 juin 2024 1 478
27 déc. 2016 à 22:01
Si je comprends bien, les lignes 135 à 137 font la mise à jour de la colonne G de Donnée équipement: 
Set ds = ThisWorkbook.Worksheets("Donnée équipement")
 L = ds.Cells.Find(ComEQUI.Value, , , xlWhole).Row
 ds.Range("G" & L).Value = lanote
Ces trois lignes sont exécutées de façon inconditionnelle (elles ne sont pas dans un 
if
): est-ce bien ce que tu veux?
Quelques remarques:
- l'indentation de ton code est insuffisante, cela le rend peu lisible (pour toi comme pour moi)
- tu n'as pas mis l'option "explicit"
- en ligne 159, tu as un 
if
sans instruction
- en ligne 150, tu as 
If ds.Range("G" & L).Value = lanote = lanote
, je pense que le deuxième 
 = lanote
est superflu
0
cedric0715
3 janv. 2017 à 16:39
bonsoir

désoler de la réponse tardive
toute d abord tous mes vœux que cette année 2017 vous apporte santé et prospérité a vous et vos proche

pour ce qui est du code
faite comme vous le voyez car moi cela fais déjà 3 a 4 semaine que je suis dessus et je n'y arrive pas
toute aide est bon a prendre
merci par avance
0
cedric0715 Messages postés 210 Date d'inscription mercredi 25 février 2015 Statut Membre Dernière intervention 6 mai 2018 > yg_be Messages postés 22891 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 16 juin 2024
5 janv. 2017 à 13:02
bonjour
a tu pu m'aider sur le sujet
merci par avance
0
yg_be Messages postés 22891 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 16 juin 2024 1 478 > cedric0715 Messages postés 210 Date d'inscription mercredi 25 février 2015 Statut Membre Dernière intervention 6 mai 2018
5 janv. 2017 à 13:06
As-tu pu améliorer en tenant compte de https://forums.commentcamarche.net/forum/affich-34212578-probleme-inscription-valeur-dans-deux-tableu-diferent#4 ?
0

Discussions similaires

Comment regarder un film complet sans inscriptions et gratuit ?
Black -
Misterenart -

2 réponses
Un seul de mes écouteurs marche. Que faire ?
VM_417 -
vali54 -

4 réponses
2 comptes facebook avec même mail et même nom
sarabi21 -
MICHEL69220 -

12 réponses