Insertion de lignes dans un tableau en tenant compte des semaines

Le fond noir est normal si vous ne mettez pas de num de semaine. Mettez S01 en B....

Effectivement

Ok on passe au suivant

1. module 2 : Supprimez tous les codes et remplacez les par ceux-ci

Option Explicit
Public lig As Integer
Public couleur As Long
Dim ref As String
Dim coul

Sub planning()
Dim i As Integer

Feuil1.Unprotect
If lig > 0 Then
    With Range(Cells(lig, 24), Cells(lig, 500))
        .UnMerge
        .ClearContents
        .Interior.Color = xlNone
    End With
    If WorksheetFunction.CountA(Range("Q" & lig & ":V" & lig)) = 6 Then

        Call maj(lig)

        For i = 1 To Range("T" & lig) / 0.5
            ActiveSheet.Unprotect
            Cells(lig, i + 23).Interior.Color = coul
        Next i

        Cells(lig, 24) = ref
        With Range(Cells(lig, 24), Cells(lig, i + 22))
            .Merge
            .HorizontalAlignment = xlCenter
        End With

    End If

Else:
    Dim j As Integer

    For i = 5 To Cells(Rows.Count, 2).End(xlUp).Row
        With Range(Cells(i, 24), Cells(i, 500))
            .UnMerge
            .ClearContents
            .Interior.Color = xlNone
        End With

        If WorksheetFunction.CountA(Range("Q" & i & ":V" & i)) = 6 Then
            Call maj(i)
            For j = 1 To Range("T" & i) / 0.5
                Cells(i, j + 23).Interior.Color = coul
            Next j

            Cells(i, 24) = ref
            With Range(Cells(i, 24), Cells(i, j + 22))
                .Merge
                .HorizontalAlignment = xlCenter
            End With
        End If
    Next i

End If
'lig = 0
ref = vbNullString
coul = vbNullString
Feuil1.Protect
End Sub

Sub maj(i As Integer)
Dim refdem As String, refpart As String, refdate As String

coul = Range("B" & i).Interior.Color
Range("C" & i) = Replace(Range("C" & i), "-", "_") 'changer tiret par souligne
refdem = Right(Range("C" & i).Value, Len(Range("C" & i).Value) - InStrRev(Range("C" & i).Value, "_")) 'ref essai
refpart = Range("F" & i).Value 'ref piece
refdate = Format(Range("V" & i), "dd/mm") 'refdate

ref = refdem & " - " & refpart & " - " & refdate

End Sub

Là vous pouvez refaire un test en cliquant sur le bouton Mise à jour.

Une fois fait, il restera l'Userform à vous donner

Fait !

On passe à l'USF. Là il y a beaucoup de codes donc le plus simple est que je vous adresse un fichier txt

- Supprimez tous les codes qui s'y trouvent
- faites un copier-coller de tous les codes du fichier joint

Il vous suffit de faire un test avec l'usf...

Espérant que cela vous convienne et surtout que les utilisateurs ne vont pas vous demander autre chose ...

Cordialement

Edit : fichier joint supprimé. Voir ce post -->https://forum.excel-pratique.com/s/goto/1178501

Code intégré. J'ai rempli tous les champs de l'usf est :

.... juste je vous ai écrit de supprimer tous les codes... sauf...

- Private Sub CommandButton2_Click() 'annuler
- Private Sub CommandButton3_Click() 'modification
- Private Sub UserForm_Initialize()
- Private Sub controle()

En principe c'était les 4 derniers
Est-ce que vous avez la possibilité de les remettre ?
Si non, je vous reposte le tout

Aïe.
Je pense que vous allez devoir me redonner le tout

Ok.

Reprenez tout dans ce fichier

Je supprime celui de mon post précédent

C'est modifié.

J'effectue des tests et vous indique où j'ai des petits soucis.

1) A chaque remplissage des cellules entre Q et W, il me protège la feuille à chaque changement de cellule
2) En cas de modification, dans l'UFS et donc des colonnes allant de K à O, il ne me met pas de couleur de fond jaune

Point 1 : je ne vois pas de souci. Dites ce que vous faites et surtout quelles cellules sont bloquées. moi je ne vois que les cellules après W
Point 2 : oups.... pour les colonnes K à O, rajoutez ces codes juste après le code Private Sub BoxNbreEmpreinte_AfterUpdate()

Private Sub BoxNbrePDC_AfterUpdate() 
If modif Then BoxNbrePDC.BackColor = Couljaune
End Sub

Private Sub BoxNbrePDDC_AfterUpdate()
If modif Then BoxNbrePDDC.BackColor = Couljaune
End Sub

Private Sub BoxNbreAspect_AfterUpdate()
If modif Then BoxNbreAspect.BackColor = Couljaune
End Sub

Private Sub BoxDateArrivéePrévisionnel_AfterUpdate()
If modif Then BoxDateArrivéePrévisionnel.BackColor = Couljaune
End Sub

Private Sub BoxDélaiSouhaité_AfterUpdate()
If modif Then BoxDélaiSouhaité.BackColor = Couljaune
End Sub

Lignes codage rajoutées et cela fonctionne

Je vous donne les précisions concernant le point 1 :
Une fois qu'un utilisateur a rentré une ligne avec usf, la feuille se protège automatiquement. Je dois la débloquer pour pouvoir entrer ou modifier des données dans les cellules allant de Q à W mais dès que je renseigne une cellule ou effectue quelconque action dans ces colonnes, la feuille se reprotège systématiquement.
Je pense qu'il faudrait que je débloque manuellement la feuille et que celle-ci se reprotège en effectuant l'action avec le bouton "Mise à jour" une fois que j'aurai renseigné l'ensemble des informations entre Q et W.

Nouveau point :
Est-il possible d'effectuer la même action que le bouton "mise à jour" dès que je valide une modification (retire le X) ?
Explication : Si un utilisateur effectue la modification "semaine", celle-ci passe en jaune (logique), il valide sa modification mais celle-ci change la couleur en jaune en X, Y, ... Même si je valide en supprimant le X, la couleur en X, Y, ... reste en jaune. Je suis obligé d'effectuer une "mise à jour" à partir de son bouton.
Je pense qu'il est faisable d'effectuer cette modification.

Je dois la débloquer pour pouvoir entrer ou modifier des données dans les cellules allant de Q à W mais dès que je renseigne une cellule ou effectue quelconque action dans ces colonnes, la feuille se reprotège systématiquement.

Oui mais si vous sélectionnez Q5 à Sx, et U5 à Wx puis que vous allez dans le menu Accueil --> Format
Cliquez sur l'onglet Protection et vérifiez que la case à cocher "Verrouillée" n'est pas cochée. Si oui décochez-la

Effectivement, je peux faire comme cela

Pour le nouveau point, si j'ai bien compris vous voulez mettre à jour le planning à chaque fois que vous retirer le X
Si c'est cela,

- Allez dans le code Private Sub Worksheet_Change(ByVal Target As Range) de la feuille Prevision
- Juste en dessous de la ligne Call ajout_couleur ..., rajoutez --> Call planning

Crdlt

Code effectué. Par contre un nouveau souci

Exemple, j'ai 3 lignes de créées : 1ère en S3, 2ème en S13 et 3ème en S14
Une modification de la semaine est effectué sur la 2ème ligne (passe de S13 à S15), celle-ci doit se retrouver donc en 3ème position
Le trie s'effectue bien et met en évidence (en jaune) le changement de semaine (S15)
Par contre, le X reste sur la 2ème ligne et j'ai 2x les infos à partir de la colonne X (voir ci-dessous)

Par contre, le X reste sur la 2ème ligne et j'ai 2x les infos à partir de la colonne X (voir ci-dessous)

Vérifiez que dans le code de tri vous avez bien un W dans cette ligne

.SetRange Feuil1.Range("A4:W" & dlg)

Bonjour Dan,

C'était bien ça, merci !

Pensez-vous qu'il soit possible que lorsque nous avons un T ou un A en colonne R, que la barre de couleur à partir de X soit grisé avec uniquement les dernières informations de la colonne C (les chiffres après le dernier tiré du 8) exemple 2024_01_1212 et donc 1212 uniquement sur fond grisé (#D9D9D9) ?
+ avoir systématiquement un alignement à gauche et non centré dans tous les cas

Merci

Bonjour,

+ avoir systématiquement un alignement à gauche et non centré dans tous les cas

Quand vous écrivez pour tous les cas, vous vous dire dans tous les cas de T et A ou aussi les autres ?

Bonne soirée, si vous me lisez

Crdlt

Bonjour,

Uniquement les renseignements indiqués dans les "barres" colorées à partir de X.
Dans tous les cas = Peu importe les informations notées en colonne R