Compléter plusieurs macros
Bonjour le forum
J'ai cette macro ci-dessous dans ThisWorkbook
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) 'Macro pour afficher Ligne A2 et Colonne J
Cancel = True
If Not Intersect(Target, Union(Range("A3,A2"), Range("I3"))) Is Nothing Then 'Ajouter ,A2 pour double cliquer sur A3 & A2
If Target.Column = 1 Then Rows(2).Hidden = Not Rows(2).Hidden 'Double Click pour afficher Ligne 2
If Target.Column = 9 Then Columns("J").Hidden = Not Columns("J").Hidden 'Double Click pour afficher Colonne J
[A1].Select
End If
End Sub
Dans un module j'ai la macro ci-dessous que je voudrais appliquer par double clic (cellule F3) mais je voudrais aussi qu'au 1er double clic ça colorie en vert (4) et qu'au 2ème double clic ça revienne à la couleur initiale 36
Sub CellulesVerrouillees()
Dim Cel As Range
For Each Cel In Range("E17:I30") 'plage à adapter
If Cel.Locked = False Then Cel.Interior.ColorIndex = 4
Next Cel
End Sub
1 - Comment compléter la macro ci-dessus?
2 - Comment l'incorporer dans la macro ThisWorkbook ou dans la feuille?
Merci pour vos éventuels retours
Cordialement
Bonjour,
Pour intégrer ta macro à l'événement, il suffit d'y inscrire le nom de ta macro, ou tu le souhaites.
Exemple :
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) 'Macro pour afficher Ligne A2 et Colonne J
Cancel = True
If Not Intersect(Target, Union(Range("A3,A2"), Range("I3"))) Is Nothing Then 'Ajouter ,A2 pour double cliquer sur A3 & A2
CellulesVerrouillees
If Target.Column = 1 Then Rows(2).Hidden = Not Rows(2).Hidden 'Double Click pour afficher Ligne 2
If Target.Column = 9 Then Columns("J").Hidden = Not Columns("J").Hidden 'Double Click pour afficher Colonne J
[A1].Select
End If
End Sub
Pour le changement de couleur, c'est aussi facile.
Regarde ceci :
Sub CellulesVerrouillees()
Dim Cel As Range
For Each Cel In Range("E17:I30") 'plage à adapter Et y mettre le nom de la feuille
If Cel.Locked = False Then
If Cel.Interior.ColorIndex = 4 Then
Cel.Interior.ColorIndex = 36
Else
Cel.Interior.ColorIndex = 4
End If
Next Cel
End Sub
Bonjour,
On va commencer tout doucement !?
A te relire.
Private Sub Workbook_SheetBeforeDoubleClick _
(ByVal Sh As Object, _
ByVal Target As Range, _
Cancel As Boolean)
Dim Cell As Range
If Not Intersect(Target, Range("A2,A3,F3,I3")) Is Nothing Then
Cancel = True
Select Case Target.Column
Case 1:
Sh.Rows(2).Hidden = Not Sh.Rows(2).Hidden
Case 6:
For Each Cell In Sh.Range("E17:I30")
If Cell.Locked = False Then
Cell.Interior.ColorIndex = 4
Else
Cell.Interior.ColorIndex = 36
End If
Next Cell
Case 9:
Sh.Columns(10).Hidden = Not Sh.Columns(10).Hidden
End Select
Cells(1).Select
End If
End Sub
Bonjour Jean-Eric
Effectivement lorsque je double click ça colorie bien les cellules déverrouillées en couleur 4 (dans lesquelles je peux taper) et les cellules verrouillées restent en 36 mais je voudrais que la feuille soit protégée car on peut taper dans les cellules verrouillées.
D'autre part lorsque je re-click dans F3 je voudrais que la couleur 4 disparaisse car je ne suis pas obligé de le faire systématiquement.
Un peux compliqué sans fichier et je m'en excuse.
Mais ça devrait pouvoir le faire car on en est pas loin
Merci à toi
Re,
Quel est le rapport avec ta macro à intégrer (Range(""E17:I30"") et ta demande spécifique sur F3 ?
Précise exactement ce que tu souhaites !...
Cdlt.
Re,
Lorsque je double clic sur cellule F3 les cellules concernées passent bien en couleur 4 mais la feuille est déprotégée et il faut qu'elle soit protégée
Ensuite lorsque je refais un double clique je veux que mes couleurs d'origine reviennent.
Mes couleurs car les cellules E17:E30 sont de couleur 2 (blanc) et G17:I30 de couleurs 36
TOUTES MES EXCUSES Quel C$N!!!
Je plaide coupable
Sub CellulesVerrouillees()
Dim Cel As Range
For Each Cel In Range("E17:E30", "G17:I30") 'E17:E30 couleur 2 G17:I30 couleur 36
If Cel.Locked = False Then Cel.Interior.ColorIndex = 4
Next Cel
End Sub
Merci mais il faut me suivre
Cordialement
Bonsoir à vous deux et merci
Voilà
Bonne fin de soirée à vous deux
Cordialement
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim Cell As Range
If Not Intersect(Target, Range("A2,A3,F3,I3")) Is Nothing Then
Cancel = True
Select Case Target.Column
Case 1:
Sh.Rows(2).Hidden = Not Sh.Rows(2).Hidden
Case 6:
For Each Cell In Sh.Range("E17:I30")
If Cell.Locked = False Then
If Cell.Interior.ColorIndex = 4 Then
If Cell.Column = 5 Or Cell.Column = 6 Then
Cell.Interior.ColorIndex = 2
Else
Cell.Interior.ColorIndex = 36
End If
Else
Cell.Interior.ColorIndex = 4
End If
End If
Next Cell
Case 9:
Sh.Columns(10).Hidden = Not Sh.Columns(10).Hidden
End Select
Cells(1).Select
End If
End Sub
Bonjour le forum
Certains programmes je dois faire un double clic sur cellule A2 à la place de F2
J'ai modifier F2 par A2
J'oublie un truc que je vois pas et qui doit-être énorme
Merci pour vos retours
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim Cell As Range
If Not Intersect(Target, Range("A2,I2")) Is Nothing Then
Cancel = True
Select Case Target.Column
Case 1:
Sh.Rows(2).Hidden = Not Sh.Rows(2).Hidden
Case 6:
For Each Cell In Sh.Range("E16:I29")
If Cell.Locked = False Then
If Cell.Interior.ColorIndex = 20 Then 'couleur bleu clair
If Cell.Column = 5 Or Cell.Column = 6 Then
Cell.Interior.ColorIndex = 2 'Couleur blanc
Else
Cell.Interior.ColorIndex = 36 'couleur jaune
End If
Else
Cell.Interior.ColorIndex = 20 'couleur bleu clair
End If
End If
Next Cell
Case 9:
Sh.Columns(10).Hidden = Not Sh.Columns(10).Hidden
End Select
Cells(1).Select
End If
End Sub