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]

Ok niquel merci, je vais étudier tout ça

 

[Goufou]

Bonjour !

Alors, J'ai tenté de transcrire ça sur mon fichier final mais je n'y arrive toujours pas x)
Est-ce que vous pourriez m'expliquer ce qui coince dans la macro ?

Merci beaucoup !

 

[sylvanu]

Bonjour,
La macro marche très bien.
Mais pour qu'un miroir marche il faut que toutes les feuilles concernées aient la même structure.
En particulier il faut que les colonnes ABC contiennent les mêmes valeurs.
Donc il faut dans ce fichier feuille Informations Générales la liste commence en A6 : salariés.
Car je ne fais pas de recherche de position mais insère ou modifie les mêmes lignes sur toutes les feuilles.
Ci joint la PJ rectifiée.

 

[Goufou]

Oui ok je vois, my bad !

Une petite question cependant, lorsque je supprime une double ligne dans "Informations générales", elle ne se supprime pas dans les autres.
De plus, j'aimerais que lorsque je fais un tri par ordre alphabétique dans "Informations Générales", cela soit repris dans les autres feuilles également.
Y-a-t-il un moyen pour que cela fonctionne ?

 

[sylvanu]

En fait, j'aimerais pouvoir rajouter des lignes comme évoqué ci-dessus

Comme demandé, le code ne fait que rajouter des lignes Ni en supprimer, ni les déplacer.
Là ça revient à gérer une BD avec synchronisation. Ce n'est plus du tout la même chose.
Désolé mais ce n'est pas faisable en l'état. Ce n'était pas l'hypothèse initiale et sa structure ne s'y prête pas.

Pour faire au plus simple vous pourriez mettre tous les jours sur une même feuille et masquer les mois pour n'en laisser qu'un visible. Ca résoudrait le problème de modifications et d'évolution.

 

[Goufou]

Oui, je vois ... ça devient beaucoup trop compliqué après ^^ je vais en rester là !

J'ai juste une question : si je veux faire les mêmes formules, la même macro, mais qu'au lieu de 2 lignes, je veux qu'il me reprenne 4 lignes, comment dois-je modifier les macros ? (voir fichier ci-joint)

Merci !

 

[sylvanu]

Bonjour,
Il vous suffit de reprendre

Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

pour les doubler. Et reprendre tous les indices pour les adapter :

Range(Target.Row - 4 & ":" & Target.Row - 3).Copy Destination:=Range("A" & Target.Row - 2)
Range(Cells(Target.Row - 2, "A"), Cells(Target.Row - 1, "B")).ClearContents

Idem pour Worksheet_Change.
... et surtout faire la mise au point surtout pour les indices.

 

[Goufou]

Bonjour,

Merci pour votre réponse.
J'ai un peu du mal à comprendre la logique.
J'ai compris qu'il fallait que je duplique les lignes "Selection.insert" mais en ce qui concerne les autres (pour les indices)

Range(Target.Row - 6 & ":" & Target.Row - 3).Copy Destination:=Range("A" & Target.Row - 2)
Range(Cells(Target.Row - 2, "A"), Cells(Target.Row - 1, "B")).ClearContents

ça ne fonctionne pas parce que je ne comprends pas les lignes en fait ^^
Concrètement, le range target row signifie la plage de donnée que je veux sélectionner ?

 

[sylvanu]

Bonjour
Le Target. Ros est la ligne que vous avez cliquée. Après insertion il faut copier les lignes -2 et -1. Si vous insérer 4 lignes alors ce sera probablement -4 et -2.

 

[Goufou]

J'ai réussi à la modifier à peu près comme je voulais :

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 - 2, "B") <> 0 Then
            Ligne = Target.Row
            Target.Interior.Color = vbRed
            Application.ScreenUpdating = False
            Application.EnableEvents = False
            If MsgBox("Voulez vous inserer des lignes ?", vbYesNo, "Insertion request") = vbYes Then
                Target.Interior.Color = vbWhite
                Rows(Target.Row & ":" & Target.Row).Select
                Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                ' Copier coller lignes  à la fin
                Range(Target.Row - 8 & ":" & Target.Row - 4).Copy Destination:=Range("A" & Target.Row - 4)
                ' Clear Cells A:B dernière ligne
                Range(Cells(Target.Row - 2, "A"), Cells(Target.Row - 1, "B")).ClearContents
                ' Fait la même modif dans toutes les feuilles
                InsertionDansToutesLesFeuilles Ligne
            Else
                Target.Interior.Color = vbWhite
                Application.EnableEvents = True
                Exit Sub
            End If
            Cells(Target.Row - 4, "A").Select
        End If
    End If
Fin:
Application.EnableEvents = True
End Sub

Maintenant le soucis est qu'il me copie bien les 4 lignes que je souhaite, mais il me rajoute aussi une ligne en dessous ... où me suis je trompé ?

 

[sylvanu]

Faites du pas à pas vous verrez à quel moment cette ligne supplémentaire est rajoutée. C'est le moyen le plus simple.

 

[fanch55]

Salut le fil

Maintenant le soucis est qu'il me copie bien les 4 lignes que je souhaite, mais il me rajoute aussi une ligne en dessous ... où me suis je trompé ?

Exécutez ces deux lignes dans votre sub, vous comprendrez le pourquoi ..

' Copier coller lignes à la fin

MsgBox Range(Target.Row - 8 & ":" & Target.Row - 4).Address
MsgBox Rows(Target.Row).Offset(-8).Resize(4).Address

 

[Goufou]

Yes,
J'ai réussi à changer et à trouver pourquoi ! C'est un peu du chinois pour moi je vous avouerai x)
Mais je commence à bien comprendre la logique de la 1ère macro !

Maintenant, il faut que je réussisse à adapter la 2ème et 3ème macro pour la reprise sur les autres feuilles, c'est une autre paire de manche ^^

 

[Goufou]

Bonjour,

Désolé de vous déranger une énième fois !
J'ai étudié le fichier ce matin et j'arrive à reprendre les informations que j'ai dans "Information générales" mais je n'arrive pas à lui faire comprendre que je veux qu'il reprenne également les lignes que j'insère.
Pourriez-vous me dire où est-ce que cela pêche dans la macro ?

Merci beaucoup

 

[fanch55]

Bonjour,
Quand vous pensez que votre code ne fait pas ce que vous voulez,
Commentez le "On error goto ...." dans votre code, il vous indiquera la ligne qui pêche.

En l’occurrence c'est celle-ci :
Range(Cells(Target.Row - 2, "A"), Cells(Target.Row - 1, "B")).ClearContents

Que je vous propose de remplacer par :
Range(Cells(Target.Row - 4, "A"), Cells(Target.Row - 1, "B")).ClearContents

car c'est quatre lignes que prend le groupe inséré .

Bonne continuation