Insertion de lignes dans un tableau en tenant compte des semaines

Ces nouvelles demandes font objet des retours reçus par les utilisateurs. Et il est vrai qu'ils ont pas tort sur le principe.

Oui j'avais compris un peu que cela devait venir de là. Mais avec Excel VBA gardez toujours en mémoire qu'en compliquant trop on a vite une "usine à gaz".

Je regarde d'abord le sujet des couleurs placées de manière automatique en cas d'ajout.
Les couleurs seront mentionnées en RGB dans le code au lieu du code Hex que vous avez donné. Les couleurs seront bien entendu celles que vous avez définies.

Une chose que vous pouvez faire, c'est dans l'USF - code Private Sub CommandButton1_Click(), mettre la ligne Call Trier après la ligne Call Mise_en_forme

Une chose que vous pouvez faire, c'est dans l'USF - code Private Sub CommandButton1_Click(), mettre la ligne Call Trier après la ligne Call Mise_en_forme

Fait !

J'attends votre retour,
Merci Dan

Pour l'ajout des couleurs vous pouvez tester cette solution

- Allez dans me module 1 --> code Mise_en_forme
- Ajoutez ceci au début du code

Dim couleur

- juste au dessus du dernier END WITH ajoutez ces lignes

'mise en couleur selon num semaine
    Select Case Right(.Range("B" & dlg), 1)
        Case Is = 0: couleur = RGB(238, 140, 138)
        Case Is = 1: couleur = RGB(155, 229, 255)
        Case Is = 2: couleur = RGB(229, 182, 181)
        Case Is = 3: couleur = RGB(198, 224, 180)
        Case Is = 4: couleur = RGB(255, 230, 153)
        Case Is = 5: couleur = RGB(155, 194, 230)
        Case Is = 6: couleur = RGB(213, 213, 173)
        Case Is = 7: couleur = RGB(177, 169, 217)
        Case Is = 8: couleur = RGB(223, 198, 49)
        Case Is = 9: couleur = RGB(173, 229, 208)
    End Select
    .Range("B" & dlg & ":O" & dlg).Interior.Color = couleur

Faites un test pour voir si ok

J'ai testé mais il m'indique erreur de compilation

Sub Mise_en_forme()
Dim couleur
Dim dlg As Integer

With Feuil1
    dlg = .Range("B" & Rows.Count).End(xlUp).Row
    With .Range("A4:V" & dlg)
        'Police
        With .Font
            .Name = "Calibri"
            .Size = 9
        End With

        'centrer
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter

        'Bordures autour
        .BorderAround LineStyle:=xlContinuous
        .BorderAround Weight:=xlThin
    End With

    'bordures verticales et horizontales
    With Union(.Range("A4:A" & dlg), Range("I4:V" & dlg))
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With

        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
    End With
    .Range("P4:P" & dlg).WrapText = True
        Case Is = 0: couleur = RGB(238, 140, 138)
        Case Is = 1: couleur = RGB(155, 229, 255)
        Case Is = 2: couleur = RGB(229, 182, 181)
        Case Is = 3: couleur = RGB(198, 224, 180)
        Case Is = 4: couleur = RGB(255, 230, 153)
        Case Is = 5: couleur = RGB(155, 194, 230)
        Case Is = 6: couleur = RGB(213, 213, 173)
        Case Is = 7: couleur = RGB(177, 169, 217)
        Case Is = 8: couleur = RGB(223, 198, 49)
        Case Is = 9: couleur = RGB(173, 229, 208)
        End Select
    .Range("B" & dlg & ":O" & dlg).Interior.Color = couleur
End With
End Sub
capture

Bah oui.. si je ne vous donne le code sans toutes les lignes....
Rajoutez ceci juste avant le 1er case is

    'mise en couleur selon num semaine
    Select Case Right(.Range("B" & dlg), 1)

J'ai corrigé dans mon post précédent


Pour le point 3, il y a peut être une solution comme ceci
- lorsque l'utilisateur fait une modification la cellule modifiée se met en jaune
- l'idée serait de consacrer une colonne (entre Q et V ou une nouvelle en W par exemple) dans laquelle on ajoute un X en cas de modification (via le bouton Modifier la ligne) ... Pour accepter la modification, il vous suffirait de supprimer le X

Dan,

Le code génère bien les couleurs mais, elles changent systématiquement à chaque modifications.
Notre souhait est de regrouper les couleurs ensemble par semaine suivant la liste que je vous avez défini.
Actuellement, j'ai 2 couleurs pour une même semaine. Si je modifie une ligne cela me régénère d'autres couleurs même pour les lignes qui n'ont pas été modifiées

Pour vous répondre au point 3, l'idée me plaît. Inutile de passer par une liste déroulante comme demandé initialement. Vous avez entièrement raison sur ce point. Création d'un X dans une colonne juste après celle des commentaires (donc P) pour avoir une visualisation Utilisateurs / Approbateur. Cela décalera toutes les autres vers la droite après coup.
Donc, si je supprime le X, cela remplace les cellules en jaune par la couleur d'origine

Merci

Le code génère bien les couleurs mais, elles changent systématiquement à chaque modifications.

Normal je n'ai pas encore regardez pour la modification


Point 3 : ok je regarde cela


Edit : c'est juste une question mais ne devriez-vous pas plutôt faire comme ceci plutôt que de mettre en P. Cette idée parce qu'une modification peut impliquer une modification de votre part entre Q et V

presse papier02

Bonjour Dan,

Oui, vous pouvez faire de cette manière

Oui, vous pouvez faire de cette manière

Ok c'est arrangé.

Concernant l'USF et la modification, on garde toujours l'idée de pouvoir modifier n'importe quelle textbox ?
Cette question parce que l'on va devoir ajouter un code pour chacun d'elle.

Concernant l'USF et la modification, on garde toujours l'idée de pouvoir modifier n'importe quelle textbox ?

Oui, car jusqu'à aujourd'hui ils me font des modifications sur toutes les colonnes (De B à P)

Bonsoir,

je pense en avoir terminé avec les modifications. Il y a pas mal de choses qui changent partout.
Si vous avez bien modifié votre fichier concernant la colonne W pour la modification je vous donnerai tous les codes.

Voici comment se présente la partie Q à W

presse papier02

En modification :
- Chaque textbox modifiée sera coloriée en jaune. Cela vous permet déjà de voir ce qui est modifié dans l'USF.
- Les cellules de la ligne modifiée dans la feuille seront coloriées en jaune et un X sera ajouté en colonne W.
- L'acceptation est faite dès que vous supprimez le X en colonne W et la ligne est remise en couleur correctement. Donc couleur adaptée à la semaine choisie
- Le planning se met à jour sur base du click sur le bouton "Mise à jour" placé sur votre feuille. Là rien de changé par rapport à ce que vous faites déjà.

Bonjour,

Colonne W ajoutée et je suis ok avoir l'ensemble de vos explications

Merci

Bonjour,

Voici. Je vais vous donnez le tout de manière progressive.

1. feuille Provisio : Supprimez toutes les lignes le code que vous avez actuellement et remplacez-les par celles ci-dessous

Option Explicit
Dim stpevt As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count > 1 Or Target.Row <= 4 Or stpevt = True Then Exit Sub

If Not Intersect(Target, Range("Q" & Target.Row & ":V" & Target.Row)) Is Nothing Then
    If Target.Column = 21 Then
        stpevt = True
        Cells(Target.Row, Target.Column) = "S" & Format(Cells(Target.Row, Target.Column), "00")
        stpevt = False
    End If
    lig = Target.Row
    Call planning
End If
If Not Intersect(Target, Range("W" & Target.Row)) Is Nothing Then
    If UCase(Target.Value) = vbNullString Then
        lig = Target.Row
        Call Ajout_couleur(lig, couleur)
    End If
End If
End Sub

2. Dans l'éditeur VBA, Module 1 : Remplacez la macro Sub Mise_en_forme et ajoutant les deux codes ci-dessous

Sub Mise_en_forme()
Dim dlg As Integer
'Dim couleur As Long

With Feuil1
    .Unprotect
    dlg = .Range("B" & Rows.Count).End(xlUp).Row
    With .Range("A4:W" & dlg)
        'Police
        With .Font
            .Name = "Calibri"
            .Size = 9
        End With

        'centrer
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter

        'Bordures autour
        .BorderAround LineStyle:=xlContinuous
        .BorderAround Weight:=xlThin
    End With

    'bordures verticales et horizontales
    With Union(.Range("A4:A" & dlg), Range("I4:W" & dlg))
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With

        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
    End With

    .Range("P4:P" & dlg).WrapText = True

    'mise en couleur selon num semaine
    Call Ajout_couleur(dlg, couleur)
    .Protect
End With
lig = 0
couleur = 0
End Sub

Sub Ajout_couleur(dlg As Integer, couleur As Long)
'mise en couleur selon num semaine
Select Case Right(Feuil1.Range("B" & dlg), 1)
    Case Is = 0: couleur = RGB(238, 140, 138)
    Case Is = 1: couleur = RGB(155, 229, 255)
    Case Is = 2: couleur = RGB(229, 182, 181)
    Case Is = 3: couleur = RGB(198, 224, 180)
    Case Is = 4: couleur = RGB(255, 230, 153)
    Case Is = 5: couleur = RGB(155, 194, 230)
    Case Is = 6: couleur = RGB(213, 213, 173)
    Case Is = 7: couleur = RGB(177, 169, 217)
    Case Is = 8: couleur = RGB(223, 198, 49)
    Case Is = 9: couleur = RGB(173, 229, 208)
End Select
With Feuil1
    .Unprotect
    .Range("B" & dlg & ":O" & dlg).Interior.Color = couleur
    .Protect
End With
End Sub

Les macros Trier et Function ne changent pas

Vous pouvez faire un test sans utiliser l'USF mais vous devez rajouter cette instruction dans le module 2 juste en-dessous de Option explicit

Public couleur As Long

Pour le test :
- ne cliquez pas sur les boutons de votre feuille. Les codes doivent être adaptés
- manuellement mettez en jaune 2 cellules : B5 et F5 (si vous y avez des données)
- ajoutez un X dans W5
- une fois fait, supprimez le X en W5 pour vois la couleur supprimée au profil de celle prévue par rapport au num de semaine

J'ai remplacé tout ce que vous m'avez indiqué.
Par contre, je n'ai pas de données pour faire le test.
J'ai tout de même essayé mais il m'indique une erreur de compilation

Par contre, je n'ai pas de données pour faire le test.

Votre tableau n'est pas vide de données je suppose

J'ai tout de même essayé mais il m'indique une erreur de compilation

Je n'ai pas d'erreur mais peut être me dire sur quelle ligne vous avez un erreur

J'avais supprimé toutes les données avant d'effectuer vos dernières modifications
Ensuite j'ai suivi votre procédure ce qui me donne cette capture (mais pas de données)

capture

Puis lorsque je supprime le X voici ce qu'il m'indique "erreur de compilation" avec ceci souligné en jaune Private Sub Worksheet_Change(ByVal Targe As Range et End If en bleu

Je suppose que c'est le fait que nous n'avons pas de donnée.

Si vous pensez que toutes les modifications ont été effectuée, nous pouvons peut-être continuer le codage et nous verrons ensuite ?

Je suppose que c'est le fait que je n'est pas de données

Pour la couleur il faut mettre au moins un numéro de semaine en B (ex : S01).

Pour l'erreur à mon avis il y a un END IF qui est de trop ou trop peu
Dans ce que je vous ai proposé il y a 4 END IF, vérifiez de ce coté là car cela vient peut-etre d'un mauvais copier-coller

Le copier/coller est conforme.
Même lorsque je tape S01 dans la cellule, j'ai déjà une erreur de compilation qui apparaît avec Private Sub Worksheet_Change(ByVal Targe As Range surligné en jaune

Et c'est pas End if qui est surligné en bleu mais lig =
Désolé

Et c'est pas End if qui est surligné en bleu mais lig =

Dans le module 2, en dessous d'option explicit, vérifiez que vous avez bien cette instruction

Public lig As Integer

J'ai intégré votre dernier code

Option Explicit
Public lig As Integer
Public couleur As Long
Sub planning()
...

Cela fonctionne mis à part qu'il m'a mis en fond noir les cellules B à O

Rechercher des sujets similaires à "insertion lignes tableau tenant compte semaines"