Compléter plusieurs macros

Le 27/08/2020 à 06:54

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

Le 27/08/2020 à 08:27

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
Le 27/08/2020 à 08:28

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
Le 27/08/2020 à 08:47

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

Le 27/08/2020 à 10:56

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.

Le 27/08/2020 à 11:53

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

Le 27/08/2020 à 18:18

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
Le 28/08/2020 à 07:18

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
Rechercher des sujets similaires à "completer macros"