XL 2019 Aide Macro + divers

Goufou · 20 Novembre 2020

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 🙂

sylvanu · 20 Novembre 2020

Bonjour Goufou,
1er item : Avez vous un fichier test ? Pas tout compris.
2eme item : Voir MFC en PJ.

Goufou · 20 Novembre 2020

Yes :
1er item : en cliquant sur un bouton, j'aimerais idéalement qu'en me positionnant sur la ligne 34, une ligne s'insère en 34 et 35 avec une couleur de remplissage verte et les horaires également en colonne C (et le reste du tableau mais ça, j'ai l'impression que c'est déjà par défaut)

2ème item : En fait, j'aimerais que ce soit le 13 le 16,17,18 et 19 qui soient en bleu clair (tous les jours du mois ou de l'année avant aujourd'hui en somme, pas juste le jour précédent)

Merci beaucoup pour votre réactivité 🙂

sylvanu · 20 Novembre 2020

1er item : C'était pas clair. Fait en PJ.
2ème item : Fait avec :

VB:

Sub Insere()
Application.ScreenUpdating = False
' Première ligne dispo
DerLig = 1 + Sheets("Feuil1").Range("C65500").End(xlUp).Row
' Copier coller lignes 8:9 à la fin
Sheets("Feuil1").Range("8:9").Copy Destination:=Sheets("Feuil1").Range("A" & DerLig)
' Clear Cells A:B dernière ligne
Sheets("Feuil1").Range(Cells(DerLig, "A"), Cells(DerLig + 1, "B")).ClearContents
End Sub

En espérant avoir bien compris votre demande.😉

Goufou · 20 Novembre 2020

Pour les dates c'est parfait 🙂

Pour le bouton, c'est de ma faute, je n'ai pas repris les catégories (vous trouverez tout ça ci-joint)
J'aimerais que lorsque je suis à la ligne 34, en cliquant sur le bouton, 2 lignes en vert s'insèrent (comme vous l'avez fait), mais que si je suis à la ligne 39, 2 lignes en jaune s'insèrent en dessous, et si je suis à la ligne 46, 2 lignes en orange clair s'insèrent. Est-ce qu'il faudrait dans ce cas faire plusieurs boutons ? (1 pour salariés, un autre pour apprentis et un autre pour stagiaires)
Désolé, ça me paraît très complexe ^^ (surtout si j'explique mal)

Merci 🙂

sylvanu · 20 Novembre 2020

Je voulais éviter plein de boutons.
En PJ il suffit de cliquer sur la première cellule vide d'une catégorie pour insérer les bonnes lignes.
Me semble plus ergonomique à l'usage.

VB:

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 - 1, "C") = "14h-18h" Then
            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
                ' Copier coller lignes  à la fin
                Sheets("Feuil1").Range(Target.Row - 4 & ":" & Target.Row - 3).Copy Destination:=Sheets("Feuil1").Range("A" & Target.Row - 2)
                ' Clear Cells A:B dernière ligne
                Sheets("Feuil1").Range(Cells(Target.Row - 2, "A"), Cells(Target.Row - 1, "B")).ClearContents
            Else
                Target.Interior.Color = vbWhite
                Application.EnableEvents = True
                Exit Sub
            End If
        End If
        Cells(Target.Row - 2, "A").Select
    End If
Fin:
Application.EnableEvents = True
End Sub

fanch55 · 20 Novembre 2020

Sinon, passer par un rightclick et le menu contextuel :

Classeur joint basé sur celui fourni, avec toutes les erreurs déjà existantes.

Goufou · 25 Novembre 2020

Bonjour !

Merci pour vos réponses 🙂

@fanch55 : Merci pour l'idée mais je préfère tout de même la solution de sylvanu que je trouve légèrement plus efficiente, mais je garde sous le coude la méthode 🙂

@sylvanu : Je n'ai pas trop compris où est-ce qu'il fallait renseigner le code, j'ai tenté de le retrouver mais sans succès, car j'ai rajouté des catégories entre temps :/

Dernière demande (fichier ci-joint) :
En fait, j'aimerais pouvoir rajouter des lignes comme évoqué ci-dessus avec le code que vous avez rentré (que je trouve effectivement beaucoup plus ergonomique) dans l'onglet "Informations Générales" (Est-ce que vous pourriez m'expliquer où saisir le code également pour que je puisse le transposer dans mon "vrai" fichier ?)
Maintenant, si c'est possible, j'aimerais que les colonnes A et B soient automatique reprises dans les autres onglets que je vais créer (Janvier, Février, etc...) afin d'éviter de devoir faire un point sur chacun des onglets à chaque fois ... (En somme, que les personnes que je renseigne dans "Informations Générales" soient automatiquement mises à jour dans chacun des mois) J'ai trouvé la formule suivante : SI(ESTVIDE('Informations générales"!Case);"";'Informations générales'!Case) mais elle me paraît un peu basique et pas très efficiente :/
(Idem, s'il vous était possible de m'expliquer comment faire afin que je puisse reproduire la méthode/formule dans le fichier mère, ce serait parfait 🙂 )

Normalement ce sera tout et après ça mon fichier sera optimisé comme je le souhaite !

Je vous remercie d'avance pour votre réponse, et surtout pour prendre de votre temps pour répondre à ce genre de requête, c'est très sympa de votre part 🙂

sylvanu · 25 Novembre 2020

Bonjour Goufou,
Voir la PJ mise à jour avec le nouveau contexte. A noter que pour insérer une ligne il faut qu'à la ligne précédente on ait bien Nom et Prénom. ( difficile de différentier puisque la colonne heure à disparue )

Pour Insérer le code au plus simple :
- Ouvrir cette PJ et votre fichier référence
- Faire ALT + F11 qui ouvre l'éditeur VBA ( ou faire onglet Développeur/Visual Basic )
- Dans l'éditeur cliquez sur cette PJ feuille Informations Générales
- Cliquez dans le code ( fenêtre de droite ) et faire CTRL+A puis CTRL+C ( Tout sélectionner/Copier )
- Dans l'éditeur cliquez dans votre fichier sur la feuille concernée.
- Cliquez dans la fenêtre de droite ( vierge ) et faites CTRL+V ( coller )

La macro revisitée à coller est la suivante :

Code:

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
            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
                ' Copier coller lignes  à la fin
                Range(Target.Row - 4 & ":" & Target.Row - 3).Copy Destination:=Range("A" & Target.Row - 2)
                ' Clear Cells A:B dernière ligne
                Range(Cells(Target.Row - 2, "A"), Cells(Target.Row - 1, "B")).ClearContents
            Else
                Target.Interior.Color = vbWhite
                Application.EnableEvents = True
                Exit Sub
            End If
        End If
        Cells(Target.Row - 2, "A").Select
    End If
Fin:
Application.EnableEvents = True
End Sub

fanch55 · 25 Novembre 2020

Salut @sylvanu ,
clic en colonne 1 sur les 8 premières lignes --> 🤔
clic en colonne 1 ligne 134 et plus --> 🤔

sylvanu · 25 Novembre 2020

Oups ! le repositionnement n'était pas à la bonne place.
Merci Fanch. 🙂

Goufou · 25 Novembre 2020

C'est parfait pour le rajout 🙂 Merci beaucoup ! J'essaye tant bien que mal de comprendre la macro mais pas facile facile ^^

En ce qui concerne mon 2ème point, auriez-vous des solutions à apporter par hasard ?

sylvanu · 25 Novembre 2020

Goufou à dit:
En ce qui concerne mon 2ème point

Un essai en PJ.
Outre l'insertion de lignes il y a recopie des valeurs sur toutes les feuilles.
Attention ! si une autre feuille doit être "épargnée" ( synthèse, stats ... ) il faut modifier les macro pour l'exclusion.

Goufou · 25 Novembre 2020

Magnifique ! Et si jamais je veux justement exclure la feuille "Plage de données" par exemple ?
Comment dois-je modifier la macro ?

sylvanu · 25 Novembre 2020

Vous avez deux fois :

VB:

If sh.Name <> "Informations Générales" Then

pour l'insertion de lignes et pour la recopie des valeurs. Vous ajoutez la nouvelle feuille :

Code:

If sh.Name <> "Informations Générales" And sh.Name <> "Plage de données" Then

XL 2019 Aide Macro + divers

XLDnaute Nouveau

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency