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 Boolean

2- 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 Sub

3- 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 Sub

En 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 rien

J'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 String

Module 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 Sub

Module 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 Sub

Merci 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+

9ayuri-bdd-test.xlsm (269.71 Ko)

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

Alors...

A++

Rechercher des sujets similaires à "macro fonction"