Selection multiples Target

Bonjour à tous :),

J'essaie de créer un petit tableur permettant de générer des diagrammes de Gantt simplifiés.

J'ai créé une macro de mise en forme conditionnelle qui colorise des cases en fonction de la ressource affectée:

Exemple, on rentre un caractère dans la plage allant de la colonne 2 à 9( ressources), puis des valeurs dans le calendrier à partir de la colonne 14; les valeurs rentrées vont se coloriser de la même couleur que la couleur affectée à la ressource.

Idem pour la plage en haut du graphique.

J'ai rajouté une macro (dont le code est spécifié ci-dessous); qui efface les valeurs et donc la colorisation si la valeur entrée dans le calendrier est supprimée (exemple R14).

Cela fonctionne sur une selection de cellule seule, mais quand je supprime plusieurs case d'un coup (par exemple R14:X14), la macro plante avec l'erreur '13' incompatibilité de type.

Auriez-vous une solution pour faire fonctionner cette macro sur une selection multiple ? j'avoue bloquer depuis quelques temps sur ce point...

Je ne sais pas si mes explications sont claires, le laisse l'ébauche de mon classeur en PJ, pour avoir une meilleure visualisation.

Merci d'avance :)

Private Sub Worksheet_Change(ByVal Target As Range)

Dim MEF As Long

nb_col = ActiveSheet.UsedRange.Columns.Count 'Compter le nb de ligne de la feuille
nb_rows = ActiveSheet.UsedRange.Rows.Count 'Compter le nb de ligne de la feuille
nb_ressources = 8

If Not Application.Intersect(Selection, Range(Cells(13, 14), Cells(nb_rows, nb_col))) Is Nothing Then

    If Target = "" Then

    col1 = Target.Column
    row1 = Target.Row

    For i = 1 To nb_ressources

            If Cells(i, col1) <> "" And Cells(i, col1).DisplayFormat.Interior.Color = Cells(row1, i + 1).DisplayFormat.Interior.Color Then
            Cells(i, col1) = ""
            End If
    Next

    End If
End If

End Sub

Bonjour

Sans trop chercher dans votre appli, vous pourriez utiliser ceci

If Target.count > 1 then
'votre code
end if

Peut être ai-je mal compris mais est-ce normal que dans votre code vous utilisez toutes les lignes alors que vous ne changez qu'une seule ligne
exemple : si vous changez F13 pour y mettre un X, le code regarde toutes les lignes depuis 13 jusque 16.
Ne serait-ce pas plus juste que si vous changez F13, seule cette ligne est concernée ?

Cordialement

Bonjour,

Merci d'avoir pris la peine de me répondre.

Concernant le premier point, j'ai essayé avec count mais cela revient au même, j'ai toujours l'incompatibilité de type, sur la case :

If Target = "" Then

Est-ce que cela ne viendrait pas du fait que target et une "range" et que la valeur d'une range ne peut-être nulle ?

Concernant la deuxième remarque, il est possible que mon code soit simplifiable ou que des incohérences existent.

Pour essayer de résumer le fonctionnement :

- Les colonnes B13 à I13 définissent la ressource sollicitée, et une mise en forme pour la suite (couleur)

- Les valeurs entrées dans le planning (N13 à ...) récupérent la mise en forme de la case coché dans la zone ressource et s'appliquent sur la case active

- Le planning "global" (à partir de N1 à N8) récupére la mise en forme et la valeur du planning pour faire une synthèse des ressources attribuées ou non sur une journée spécifique.

- Quand une valeur est supprimée dans le planning, la macro vient supprimer la valeur correspondante dans la synthèse. Pour éviter de supprimer toutes les cases de la colonne concernée (N1:N8 par exemple), j'ai mis une boucle qui effectivement itère sur les différentes ressources en fonction de la couleur : on ne supprime que les cases qui ont la même couleur que dans la zone ressource.

Il y a certainement une autre façon de procéder, mais c'est pour l'instant la seule qui à fonctionnée, en cherchant à "taton".

Je ne sais pas si mon explication a été plus claire,

Cordialement,

Je n'arrive pas à avoir cette erreur
Pouvez-vous mettre un exemple de ce que je dois faire.

Voici ce que je fais :

1. Je mets un X en F13.
2. si je mets un 1 en S13, cela mettre une couleur rouge et appliquer la couleur rouge et le chiffre 1 en S5

Rebonjour,

J'ai trouvé une solution:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim MEF As Long
Dim c As Range

nb_col = ActiveSheet.UsedRange.Columns.Count 'Compter le nb de ligne de la feuille
nb_rows = ActiveSheet.UsedRange.Rows.Count 'Compter le nb de ligne de la feuille
nb_ressources = 8

If Not Application.Intersect(Selection, Range(Cells(13, 14), Cells(nb_rows, nb_col))) Is Nothing Then

For Each c In Target
If c = "" Then

col1 = c.Column
row1 = c.Row

For i = 1 To nb_ressources

If Cells(i, col1) <> "" And Cells(i, col1).DisplayFormat.Interior.Color = Cells(row1, i + 1).DisplayFormat.Interior.Color Then
Cells(i, col1) = ""
End If
Next

End If
Next c
End If

End Sub

je rajoute une boucle for each et itère sur chaque valeur de target. Cela servira peut-être à quelqu'un

Désolé je répond à votre message un peu tard :

Si vous mettez un X en F13 : le X se colore normalement en rouge

Le 1 en "S13" devrait aussi se coloriser en rouge.

Si vous rajoutez un "1" en S13 et aussi sur les cases T13 à AA 13 par exemple elles se coloriseront en rouge aussi. Idem pour les cases S5 et T5 à AA5.

Maintenant, si on veux effacer les cases S13 et T13à AA13 d'un coup (en selectionnant plusieurs cases et en appuyant sur supprimer), le code indiquait une erreur, alors que si on les selectionne une par une pour les effacer, cela fonctionne

Le souci que je vois vient aussi de votre code selection_change qui s'exécute à chaque sélection de cellule.
Exemple : vous sélectionnez S13 puis vous mettez en 1 dans la cellule et appuyez sur la touche entrée. Le code va s'exécuter 2 x. cela lié au code qui vous pose souci ....

Mais ok si vous avez solution
NB : à vérifier mais vous pouvez aussi remplacer Selection par target dans le code Worksheet_Change

Bonjour… (salut Dan )

Sans toucher au reste*, dans l’événement Change récursif, remplace If Target = "" Then par If Target(1, 1) = "" Then

Target(1, 1) désigne la première cellule de la sélection**.

*Je ne hasarderais pas à programmer sur 6 ans

** quand je vois le peu de personnes adopter cette saisie (où les lignes et colonnes sont variables) ...

Bonjour à tous,

Merci pour vos interventions et conseils.

J'ai pu simplifié la macro, qui fonctionne effectivement bien mieux et est beaucoup moins bancale.

Avec target(1,1), cela fonctionne mais on n'efface que la première cellule de la selection. Je suis donc resté sur l'option "for each c in target".

Voici le code :

Private Sub Worksheet_Change(ByVal Target As Range)

'MsgBox Target.Row
'MsgBox Target.Column

Dim MEF As Long

nb_col = ActiveSheet.UsedRange.Columns.Count 'Compter le nb de ligne de la feuille
nb_rows = ActiveSheet.UsedRange.Rows.Count 'Compter le nb de ligne de la feuille
nb_ressources = 8

If Not Application.Intersect(Target, Range(Cells(13, 14), Cells(nb_rows, nb_col))) Is Nothing Then

For Each c In Target
    If c > 0 Then

        For i = 2 To nb_ressources + 1

            If Cells(c.Row, i) <> 0 Then
                MEF = Cells(c.Row, i).DisplayFormat.Interior.Color

            End If
        Next

        With c         'Sélection des plages où doit s'appliquer la MeF
                .FormatConditions.Delete 'Supprime les MFC existantes

                .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, Formula1:="0" 'Ajoute une condition (Vrai lorsque la cellule est > 0)

                With .FormatConditions(1)
                    'Définit la couleur de fond de la cellule lorsque la condition sera vraie.
                    .Interior.Color = MEF       'récupération de la mise en forme des ressources

                End With

            End With

        For j = 1 To nb_ressources

            If Cells(j, 13).Interior.Color = MEF Then
                Cells(j, c.Column).Interior.Color = MEF
                Cells(j, c.Column).Value = Cells(j, c.Column) + c.Value

                    If Cells(j, c.Column).Value > 1 Then
                        MsgBox ("La ressource est déjà sollicitée ce jour-là. Merci de revoir le planning.")
                        Target.Value = ""
                    End If

            End If
        Next

    End If

    If c = "" Then

        For i = 1 To nb_ressources

            If Cells(i, c.Column) <> "" And Cells(i, c.Column).DisplayFormat.Interior.Color = Cells(c.Row, i + 1).DisplayFormat.Interior.Color Then
            Cells(i, c.Column) = ""
            Cells(i, c.Column).Interior.Color = RGB(255, 255, 255)
            End If
        Next

    End If

Next c

End If

End Sub

Merci encore,

Bonne journée

Re...

Avec target(1,1), cela fonctionne mais on n'efface que la première cellule de la selection

Pas chez moi (sélection d'une plage puis suppression), avec ton fichier n'ayant subi que le remplacement.

Nota comme je l'ai dit je n'ai regardé que cela mais attention si tu n'as pas borné tes sélections quand tu supprimes des contenus!

Rechercher des sujets similaires à "selection multiples target"