XL 2019 Aide Macro + divers

[Goufou]

Bonjour à tous,

Je suis complètement néophyte concernant VBA et j'ai quelques petites questions.

J'aimerais insérer un bouton qui me permette, lorsque je clique dessus, d'insérer une ligne (avec message de confirmation), qui reprendrait la mise en forme de la ligne d'au-dessus (concrètement j'ai 5 "catégories" dans la même colonne avec une couleur de remplissage différente). Donc j'aimerai que lorsque j'insère une ligne dans la 1ère catégorie, en me plaçant à la bonne ligne pour qu'il reprenne la couleur de la ligne d'au-dessus, il me reprenne la couleur de remplissage verte, dans la 2ème, la couleur jaune, etc ...
Je ne sais pas si c'est très clair ? ^^

Voici le code que j'ai repris de mes nombreuses recherches et essayé de modifier x) :
Concrètement, à chaque fois que j'insère une ligne via le bouton, la mise en forme n'est pas reprise mais lorsque je l'insère en faisant clic droit insérer, ça fonctionne bien ..

Sub Insertionligne()

Dim lRow As Long
Dim lRsp As Long
On Error Resume Next

lRow = Selection.Row()
lRsp = MsgBox("Insérer une nouvelle ligne à la ligne " & lRow & "?", _
vbQuestion + vbYesNo)
If lRsp <> vbYes Then Exit Sub

Rows(lRow).Select
Selection.Copy
Rows(lRow + 1).Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False

'Paste formulas and conditional formatting in new row created
Rows(lRow).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone

End Sub

Aussi, j'ai des dates tout en haut de mon tableau, j'aimerais faire une mise en forme conditionnelle qui ferait en sorte que par exemple, étant le 20 novembre, cette case se met en vert (ça je sais faire) mais que le 19 novembre étant passé, cette case se mette en bleu clair par exemple. et que le lendemain, le 21 novembre soit en vert et le 20 en bleu clair (je pense que vous avez compris ^^).

Est-ce que quelqu'un aurait des éléments de réponse sur ces sujets ?

Merci beaucoup

 

[Goufou]

Ah, je l'avais déjà remplacé comme cela mais le problème c'est que ça ne me rajoutait pas la bonne mise en forme dans les autres feuilles :/ ça me duplique les 2 dernières lignes (14h-16h et 16h-18h) mais pas celles du dessus et les cases "A" et "B" ne sont pas fusionnées :/
J'ai essayé de changer les indices en voyant comment au fur et à mesure cela changeait mais j'y arrive pas :/

 

[fanch55]

La sous-sub souffrait du même problème.
Correction proposée :

' Only for test to init of EnableEvents to True
Private Sub EventsOn()
    Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    'On Error GoTo Fin
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("A1:A1000")) Is Nothing Then
        If Target.Interior.Color = vbWhite And Cells(Target.Row - 4, "B") <> 0 Then
            Target.Interior.Color = vbRed
            Application.EnableEvents = False
            If MsgBox("Voulez vous inserer des lignes ?", vbYesNo, "Insertion request") = vbYes Then
                Target.Interior.Color = vbWhite
                Application.ScreenUpdating = False
                InsertionDansToutesLesFeuilles Target.Row
            Else
                Target.Interior.Color = vbWhite
                Application.EnableEvents = True
                Exit Sub
            End If
            Cells(Target.Row, "B").Select
        End If
    End If
Fin:
Application.EnableEvents = True
End Sub
' Ce module duplique les insertion de lignes faites dans Informations Générales dans toutes les feuilles
Private Sub InsertionDansToutesLesFeuilles(Ligne)
Dim Sh As Worksheet
For Each Sh In ActiveWorkbook.Sheets
'     If Sh.Name <> "Informations Générales"
    If Sh.Name <> "Plage de données" _
    And Sh.Name <> "Jours fériés" _
    And Sh.Name <> "Récap 2021" Then
        With Sh
            .Activate
            ' Copie des 4 lignes au dessus
            .Range(Ligne - 4 & ":" & Ligne - 1).Copy
            .Rows(Ligne).Insert Shift:=xlDown
             Application.CutCopyMode = False
            ' Clear Cells A:B dernière ligne
            .Range("A" & Ligne & ":B" & Ligne + 3).ClearContents
        End With
    End If
Next Sh
Sheets("Informations Générales").Select
End Sub
' Ce module recopie les infos entrées dans Informations Générales dans toutes les feuilles
' Mise à jour pour toutes cellules modifiées en colonne A et B
' Y compris s'il n'y a pas eu d'insertion, par ex la rectification d'une faute d'orthographe.
Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Fin2
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("A1:B1000")) Is Nothing Then
        If Target.Interior.Color <> vbWhite And Target <> "" Then   ' Uniquement si cellule non blanche et non vide
            For Each Sh In ActiveWorkbook.Sheets
                If Sh.Name <> "Informations Générales" And Sh.Name <> "Plage de données" And Sh.Name <> "Jours fériés" And Sh.Name <> "Récap 2021" Then
                    Sheets(Sh.Name).Range(Target.Address) = Target
                End If
            Next Sh
        End If
    End If
Fin2:
End Sub

Ceci dit, à l'analyse du code,:

• si vous avez un quelconque problème, vous risquez d'avoir une désynchronisation des mois entre eux et avec "Informations Générales"
• pourquoi n'insérer que si B n'est pas vide ?