XL 2019 Aide Macro + divers

Goufou

XLDnaute Nouveau
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

XLDnaute Nouveau
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é :)
 

Pièces jointes

  • Fichier Test.xlsx
    325.1 KB · Affichages: 2

sylvanu

XLDnaute Barbatruc
Supporter XLD
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.;)
 

Pièces jointes

  • Fichier Test.xlsm
    346.2 KB · Affichages: 4

Goufou

XLDnaute Nouveau
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 :)
 

Pièces jointes

  • Fichier Test V2.xlsm
    337.8 KB · Affichages: 7

sylvanu

XLDnaute Barbatruc
Supporter XLD
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
 

Pièces jointes

  • Fichier Test V3.xlsm
    331.5 KB · Affichages: 5
Dernière édition:

fanch55

XLDnaute Barbatruc
Sinon, passer par un rightclick et le menu contextuel :
Mosti.gif


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

Pièces jointes

  • MOSTI.xlsm
    345.6 KB · Affichages: 3

Goufou

XLDnaute Nouveau
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 :)
 

Pièces jointes

  • Exemple V3.xlsx
    43.5 KB · Affichages: 2

sylvanu

XLDnaute Barbatruc
Supporter XLD
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
 

Pièces jointes

  • Exemple V3.xlsm
    52.4 KB · Affichages: 4

Discussions similaires

  • Question
Microsoft 365 Tableau
Réponses
24
Affichages
890

Statistiques des forums

Discussions
315 087
Messages
2 116 084
Membres
112 655
dernier inscrit
fannycordi