Une macro en fonction d'une autre
Bon.
Ce que j'ai fait :
1- déclarer dans le module1 une variable booléenne publique :
Public Flag As Boolean2- Afficher l'userform en cas de non résultat :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cel As Range
If Flag = False Then
If Target.Count > 1 Then Exit Sub
End If
Flag = False
If Not Application.Intersect(Target, Range("A4:O4")) Is Nothing Then
Application.ScreenUpdating = False
Application.EnableEvents = False
For Each Cel In Range("A4:O4")
If Cel <> "" Then
If Not IsNumeric(Cel) Then
Cel.Offset(-1) = "*" & Cel.Value & "*"
Else
Cel.Offset(-1) = Cel.Value
End If
Else
Cel.Offset(-1).ClearContents
End If
Next Cel
Application.EnableEvents = True
Range("A6:P1000").AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=Range("A2:O3"), Unique:=False
End If
Dim LgFin As Long
LgFin = Range("A" & Rows.Count).End(xlUp).Row
If Evaluate("SUBTOTAL(3,A7:A" & LgFin & ")") = 0 Then UserForm2.Show
End Sub3- Incrémentation au clic sur le commandButton :
Private Sub CommandButton1_Click() 'Fermeture de la boite de dialogue apres un click sur "Valider"
Incrémentation_de_Tmin = IIf(OptionButton1.Value = True, "OK", "NON")
Incrémentation_de_Tmax = IIf(OptionButton2.Value = True, "OK", "NON")
Incrémentation_des_deux = IIf(OptionButton3.Value = True, "OK", "NON")
If MsgBox("confirmez-vous incrementation?", vbYesNo, "confirmation") = vbYes Then
Unload Me
If OptionButton1 Then Range("F4").Value = Range("F4").Value - 5
If OptionButton2 Then Range("I4").Value = Range("I4").Value + 5
If OptionButton3 Then
Flag = True
Sheets("Feuil1").Range("F4:I4").Copy Sheets("Feuil2").Range("F1:I1")
Sheets("Feuil2").Range("F1") = Sheets("Feuil2").Range("F1") - 5
Sheets("Feuil2").Range("I1") = Sheets("Feuil2").Range("I1") + 5
Sheets("Feuil2").Range("F1:I1").Copy Sheets("Feuil1").Range("F4")
End If
End If
End SubEn gros :
changement '//Changement de valeur dans F4 ou I4
SI pas de résultat
Lancement userform de choix
Si choix1 ou choix2 => Fermeture Userform => retour à changement
Si choix3 => copié/collé avec Feuil2 '//pour changer les 2 cellules en même temps
=> Flag = True '//pour contourner If Target.Count > 1 Then Exit Sub
=> Fermeture Userform
SI résultat
On ne fait rienJ'ai également quelque peu modifié ton Userform, notamment en supprimant le textbox de saisie de la marge, puisque tu veux toujours +-5
Ton classeur :
Merci géniale ça m'avance déjà beaucoup.
Excuse moi de te déranger encore :/
est ce que c'est possible d'automatiser l'incrémentation c'est-à-dire :
j'aimerais que l'userform s'affiche qu'une seule fois et que l'incrémentation se fasse toute seule jusqu'à que la recherche trouve un résultat ?
je sais pas si je suis précise :/
Il faut te prévoir une "porte de sortie".
Si l'incrémentation est automatique et qu'aucune valeur n'est trouvée, tu va boucler sans fin.
Ou si, plutôt Excel va finir par planter.
Alors qu'elle serait cette "porte de sortie"?
Une valeur Max ou Min???
Autre?
A toi de voir...
je pensais à une boucle qui le ferais un certain nombre de fois et après s'il n'y a pas de résultat qu'il arrête la boucle je pensais à 100 fois ? qu'en pense tu ??
je voulais savoir pourquoi dans ton code pou l'incrémentation c'est marquer feuil2 ? car c'est sur la feuil1 que ce passe l'incrémentation ?
je voulais savoir pourquoi dans ton code pou l'incrémentation c'est marquer feuil2 ?
Comme je te l'ai décrit dans ma réponse précédente :
changement '//Changement de valeur dans F4 ou I4
SI pas de résultat
Lancement userform de choix
Si choix1 ou choix2 => Fermeture Userform => retour à changement
Si choix3 => copié/collé avec Feuil2 '//pour changer les 2 cellules en même temps
=> Flag = True '//pour contourner If Target.Count > 1 Then Exit Sub
=> Fermeture Userform
SI résultat
On ne fait rien
En fait, lors d'une "double incrémentation", il faut changer les deux valeurs en même temps. CEci à cause du déclenchement de la macro événementielle Worksheet_Change. Pour cela, il faut faire
- un copié des valeurs Feuil1!F4:I4 vers la Feuil2!F1:I1 (choix aléatoire, tu peux changer là ou tu veux les coller),
- modifier ces valeurs dans la Feuil2
- copié-collé vers la Feuil1
je pensais à 100 fois ? qu'en pense tu ??
C'est toi qui voit. Je vois ça.
je pense que 100 c'est bien. Merci de ton aide
Les différents codes:
Module1 :
Public Flag As Boolean
Public Premiere As Boolean
Public Quitter As Boolean
Public Incrémentation_de_Tmin As String
Public Incrémentation_de_Tmax As String
Public Incrémentation_des_deux As StringModule de l'userform
Attention, il s'agit du code complet. Donc supprime de ton code ce qui n'apparait pas dans le mien!!!
Private Sub CommandButton1_Click() 'Fermeture de la boite de dialogue apres un click sur "Valider"
Dim Cpt As Byte
Incrémentation_de_Tmin = IIf(OptionButton1.Value = True, "OK", "NON")
Incrémentation_de_Tmax = IIf(OptionButton2.Value = True, "OK", "NON")
Incrémentation_des_deux = IIf(OptionButton3.Value = True, "OK", "NON")
If MsgBox("confirmez-vous incrementation?", vbYesNo, "confirmation") = vbYes Then
Unload Me
For Cpt = 1 To 100
If Quitter Then Quitter = False: Exit For
If Incrémentation_de_Tmin = "OK" Then Range("F4").Value = Range("F4").Value - 5
If Incrémentation_de_Tmax = "OK" Then Range("I4").Value = Range("I4").Value + 5
If Incrémentation_des_deux = "OK" Then
Flag = True
Sheets("Feuil1").Range("F4:I4").Copy Sheets("Feuil2").Range("F1:I1")
Sheets("Feuil2").Range("F1") = Sheets("Feuil2").Range("F1") - 5
Sheets("Feuil2").Range("I1") = Sheets("Feuil2").Range("I1") + 5
Sheets("Feuil2").Range("F1:I1").Copy Sheets("Feuil1").Range("F4")
End If
Next Cpt
End If
End Sub
Private Sub CommandButton2_Click() ' Si l'on clique sur "Quittez" les valeurs des variables sont réinitialisées
Unload UserForm2
End Sub
Private Sub UserForm_Initialize()
OptionButton1.Value = False
OptionButton2.Value = False
OptionButton3.Value = False
Quitter = False
Premiere = True
End SubModule de la feuille :
Option Explicit
Private Sub CommandButton1_Click()
UserForm1.Show
End Sub
Private Sub CommandButton3_Click()
UserForm2.Show
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cel As Range
If Flag = False Then
If Target.Count > 1 Then Exit Sub
End If
Flag = False
If Not Application.Intersect(Target, Range("A4:O4")) Is Nothing Then
Application.ScreenUpdating = False
Application.EnableEvents = False
For Each Cel In Range("A4:O4")
If Cel <> "" Then
If Not IsNumeric(Cel) Then
Cel.Offset(-1) = "*" & Cel.Value & "*"
Else
Cel.Offset(-1) = Cel.Value
End If
Else
Cel.Offset(-1).ClearContents
End If
Next Cel
Application.EnableEvents = True
Range("A6:P1000").AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=Range("A2:O3"), Unique:=False
End If
Dim LgFin As Long
LgFin = Range("A" & Rows.Count).End(xlUp).Row
If Evaluate("SUBTOTAL(3,A7:A" & LgFin & ")") = 0 And Premiere = False Then
UserForm2.Show
ElseIf Evaluate("SUBTOTAL(3,A7:A" & LgFin & ")") = 0 And Premiere = True Then
ElseIf Evaluate("SUBTOTAL(3,A7:A" & LgFin & ")") > 0 Then
Quitter = True: Premiere = False
End If
End SubMerci le module 1 je dois l'écrire ou ?
Merci le module 1 je dois l'écrire ou ?
Je ne l'ai pas inventé ce module1.
Dans le classeur que tu nous as passé, il y a au moins 10 modules.... dont le Module1.
tu mets le code donné dedans.
c'est bon j'ai trouver au final mais ca ne marche pas admettons que je marque 215 dans Tmax donc dans I4 il va me donne une tempéréture inférieur
Bon.
On va faire simple.
Je ne comprends pas ce que tu veux, et encore moins ce que tu me dis à ta dernière réponse...
"ca ne marche pas" n'a jamais aidé qui que ce soit à savoir ce qu'il se passe.
Je vais donc t'inviter à :
- analyser les codes donnés
- tenter, par toi-même, de les modifier pour arriver à tes fins,
- le cas échéant, si tu n'y parviens pas, revenir ici avec la problématique.
Parce que là, en 1 minute, tu n'as pas eu le temps de regarder ce qui ne "marche" pas et tu es déjà revenu avec tes questions...
oui excusez moi mais j'ai essayé en température min et en température max et au final il ne recherche plus dans la base de donnée il me laisse mon tableau tel qu'il est de base sans température ni rien même pour une température qui existe ...
Bonjour le fil,
Désolé, pas mal occupé sur d'autres choses en gestion
Voilà le fichier avec le code modifié, du comment je vois ça
Désolé pijaku si je te court-circuite
A+
re bonjour bruno
merci pour le fichier
Re bonjour j'ai tester ton fichier et la barre de recherche ne recherche plus pour aucun therme ....
et l'incrémentation ne se fait pas pour la température ...
Comment puis je faire pour changer cela ?
Merci j'ai trouvé comment faire merci à vous deux c'est gentil de m'avoir aidé
c'est super gentil bonne journée
Bonjour Bruno, ayuri, le fil,
@BrunoM45 : non tu ne court-circuite personne.
Nos méthodes sont fort similaires, et tant mieux si ça a fait aboutir l'ami ayuri.
Je pensais à cela, mais ne serait-il pas judicieux de réaliser ce filtre en mémoire plutôt que de systématiquement passer par des modifications de feuille?
Du style :
>Lors d'une modif de F4 ou I4 :
=> Stockage de toute la base dans un tableau Tb_In(1 To dLign, 1 To dCol)
=> Lancement d'une fonction qui boucle sur tout le tableau colonne Target.Column et qui retourne les éventuelles lignes ou la valeur est trouvée
==> si valeur(s) trouvée(s) : on masque les "mauvaises" lignes
==> si pas trouvée
===> choix de l'utilisateur
===> Lancement d'une fonction de recherche (toujours dans Tb_In) de valeur incrémentées de +-5.
====> si pas trouvée après 100 incrémentation => message + sortie [à ce stade on n'a pas touché la feuille]
====> si trouvé => affichage
De cette manière, on ne touche à l'affichage qu'une seule fois et aux fonctions (notre Evaluate(sous.total)) pas du tout...
Merci pour votre réponse mais je ne pense pas aller plus loin dans la recherche en VBA cela me convient très bien comme cela c'est ce que je rechercher à faire.
Merci beaucoup pour votre aide et à bientôt