Faire apparaitre un objet forme lorsqu'une cellule est remplie

Le 12/06/2023 à 06:30

Bonjour

Je souhaite faire apparaitre une image lorsqu'une cellule est remplie avec certaines informations.

J'y arrive en passant par le gestionnaire des noms mais cela ralenti enormement l'ordinateur.

L'on m'a conseillé de le faire par une macro.

J'y arrive mais il faut que je clique sur un bouton.

Je n'arrive pas à le faire automatiquement lorsque la cellule est remplie.

Je joint une fichier pour explication.

En vous remerciant.

15essai.zip (363.01 Ko)
Le 12/06/2023 à 08:12

bonjour bejouette,

vous avez déjà commencé à utiliser des evenements dans le module de "Division". Vous ajoutez ceci là-dedans

Private Sub Worksheet_Change(ByVal Target As Range)
     If Intersect(Target, Range("F17:H18")) Is Nothing Then Exit Sub
     Bouton7_Cliquer
End Sub

Mais je n'ai pas d'idée sur le fonctionnement globale.

Le 12/06/2023 à 21:17

Bonsoir BsAlv,

Merci pour votre formule.

Elle me va à ravir.

En vous remerciant pour votre aide.

Bonne soirée.

Bien cordialement.

Le 12/06/2023 à 22:21

Bonsoir bejouette,

Bonsoir BsAlv !

Sinon connaissez vous "Visible" ? Par exemple pour les "Yeux" plutôt que de les mettre derrière un carré blanc pour le cacher, il suffit de les rendre invisible ou visible "à la demande" et il n'est pas nécessaire de les sélectionner pour "travailler" dessus :

Vous pouvez remplacer ceci :

    If Range("G17") = "" And Range("H18") > Range("H17") Then
    ActiveSheet.Shapes.Range(Array("yeux")).Select
    Selection.ShapeRange.ZOrder msoBringToFront  'apparait
    End If

Par :

    If Range("G17") = "" And Range("H18") > Range("H17") Then
        ActiveSheet.Shapes("yeux").Visible = True 'apparait
    End If

Et vous aurez compris que pour le cacher il suffit de mettre "Visible" à False, et ceci marche également pour le "Moins 1", en lieu et place de la transparence il suffit de dire s'il est visible ou pas...

Voici le code Bouton7_Cliquer modifié dans ce sens :

Sub Bouton7_Cliquer()

' Bouton7_Cliquer Macro

    ActiveSheet.Unprotect

    'IL Y A D'AUTRES CONDITIONS MAIS MIS LE MINIMUM POUR DONNER UNE IDÉE.

    'SUPPRESSION DU MOINS.
    ActiveSheet.Shapes("moins 1").Visible = False

    'SUPPRESSION YEUX.
    ActiveSheet.Shapes("yeux").Visible = False

    'SI OPERATION NON COMPATIBLE, APPARITION YEUX.
    '5-6
    If Range("G17") = "" And Range("H18") > Range("H17") Then
        ActiveSheet.Shapes("yeux").Visible = True
    End If

    '5-5 OU 15-15
    If Range("H18") <= Range("H17") And Range("G18") <= Range("G17") Then
        ActiveSheet.Shapes("moins 1").Visible = True
    End If

    '15-6
    If Range("F18") = "" And Range("H18") > Range("H17") And Range("G18") + 1 <= Range("G17") Then
        ActiveSheet.Shapes("moins 1").Visible = True
    End If

    '16-15
    If Range("F18") = "" And Range("H18") > Range("H17") And Range("G18") + 1 < Range("G17") Then
        ActiveSheet.Shapes("moins 1").Visible = True
    End If

    'SI OPERATION NON COMPATIBLE, APPARITION YEUX.
    '15-16
    If Range("F18") = "" And Range("G18") <> "" And Range("H18") > Range("H17") And Range("G18") + 1 > Range("G17") Then
        ActiveSheet.Shapes("yeux").Visible = True
    End If

    'SI OPERATION NON COMPATIBLE, APPARITION YEUX.
    '15-21
    If Range("F18") = "" And Range("G18") <> "" And Range("H18") <= Range("H17") And Range("G18") > Range("G17") Then
        ActiveSheet.Shapes("yeux").Visible = True
    End If

    Range("G17").Activate

    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub

@ bientôt

LouReeD

Le 13/06/2023 à 22:32

Bonsoir LouReeD,

Je tenais à vous remercier pour plusieurs raisons, à savoir:

1) D'avoir pris le temps de lire ma demande.

2) De m'avoir appris quelque chose.

3) Votre solution me simplifie la vie.

4) D'avoir expliqué le pourquoi de votre suggestion.

4) D'avoir pris le temps de me rectifier sur toutes les lignes de mon fichier, votre modification.

C'est vraiment sympa.

Un grand merci.

Bonne soirée.

Bien cordialement.

Le 14/06/2023 à 19:06

Bonsoir BsAlv,

J'ai voulu insérer une autre ligne à savoir E22:J23 et là, cela ne fonctionne pas dans les calculs sur E22:J23.

Si je fais E17 : J23 sur bouton1 (sans bouton2) cela fonctionne bien.

Donc j'en déduis que l'apport de ma deuxième fonction avec bouton2 ne lui convient pas.

J'ai essayé de supprimer exit sub sur le bouton 1 et mettre end if à la fin, mais l'opération ne se fait pas.

Si tu as une idée.

En te remerciant.

Bonne réception.

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("e17:J18")) Is Nothing Then Exit Sub

bouton1_Cliquer

'End If

If Intersect(Target, Range("e22:J23")) Is Nothing Then Exit Sub

bouton2_Cliquer

'End If

End Sub

Le 14/06/2023 à 21:16

Bonsoir,

Merci pour votre retour et remerciements !

Pour votre nouvel problématique, il faut, dans ce cas je pense, faire le test "double négation" :

Private Sub Worksheet_Change(ByVal Target As Range)
' si NOT l'intersection de la cellule changée par rapport à la plage surveillée est rien = si il y a intersection entre les deux alors clique bouton 1
If Not Intersect(Target, Range("E17:J18")) Is Nothing Then
    bouton1_Cliquer
' sinon on fait un test équivalent avec la deuixième zone
ElseIf Not Intersect(Target, Range("E22:J23")) Is Nothing Then
    bouton2_Cliquer
End If
' si aucune intersection trouvée alors on a rien fait
End Sub

@ bientôt

LouReeD

Le 14/06/2023 à 22:06

Bonsoir LouReeD,

Un grand merci pour votre aide car je ne l'aurais pas trouvé.
Cela fonctionne à merveille.
Après avoir recopié la formule, il m'a juste dit qu'il manquait end if à la fin.
Ce qui n'est pas un problème.

Encore merci.

Bonne soirée.
Cordialement.

Le 14/06/2023 à 22:09

Oui par erreur sur le code j'ai mis un apostrophe avant le EndIf ! Je le corrige de ce pas !

Bonne soirée et merci pour les remerciements.

@ bientôt

LouReeD

Rechercher des sujets similaires à "apparaitre objet forme lorsqu remplie"