XL 2016 Aide pour maj auto de la date + selection multiple dans une liste déroulante

[petitbuzuc]

Bonjour à tous

j'ai un fichier excel à faire : je vous le mets en PJ.

dans la colonne J, j'ai une macro qui me permet de sélectionner plusieurs items dans une liste déroulante

If Target.Column = 10 And Target.Address <> "$J$1" Then
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
Else: If Target.Value = "" Then GoTo Exitsub Else
Application.EnableEvents = False
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If Oldvalue = "" Then
Target.Value = Newvalue
Else
If InStr(1, Oldvalue, Newvalue) = 0 Then
Target.Value = Oldvalue & ", " & RetourChariot & Newvalue
Rows(ActiveCell.Row).EntireRow.AutoFit
Else:
Target.Value = Oldvalue
End If
End If
End If
End If


mais je veux aussi rajouter un code vba pour que lorsque quelque chose est modifié sur la ligne (sauf colonne A), alors on met la date et l'heure de la modification en colonne A

Dim ligne As Integer
For ligne = 2 To 10000
Set Plage = Range("B" & ligne & ":Z" & ligne)
If Application.Intersect(Target, Plage) Is Nothing Then
'Hors cible on ne fait rien.
Else
Cells(ligne, "A").Value = Date & " " & Time
Cells(ligne, "A").NumberFormat = "dd/mm/yyyy"
End If
Next
Range("A:A").EntireColumn.AutoFit



Chaque bout de code fonctionne, mais quand je mets les 2 morceaux de code, alors ça ne fonctionne plus.
:-(
je pense que le pb vient que la "target" revient en colonne A une fois que j'ai modifié la colonne J et que du coup, ça n'arrive pas à permettre de selectionner plusieurs items de ma liste déroulante en J.


voila voila ...

si vous avez du code plus efficace, je suis preneuse !!!

Merci d'avance pour votre aide !
Anne

 

[Annach]

Bonjour Petitbuzuc,

Le code est correct mais il faut séparer les 2 actions et ne faire appel à la fonction sur J que si modification sur J (création de la "function colonne_J" au même endroit que le 1er code) .

Option Explicit 'oblige à la déclaration de toutes les variables
  
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ligne As Integer
Dim Plage As Range

If Target.Column = 10 And Target.Address <> "$J$1" Then   'si la colonne J est modifiée, alors on fait appel à la fonction 
    Call colonne_j(Target)
End If

For ligne = 2 To 10000
    Set Plage = Range("B" & ligne & ":Z" & ligne)
    If Application.Intersect(Target, Plage) Is Nothing Then
        'Hors cible on ne fait rien.
    Else
        Cells(ligne, "A").Value = Date & " " & Time
        Cells(ligne, "A").NumberFormat = "dd/mm/yyyy"
    End If
Next
Range("A:A").EntireColumn.AutoFit
Exitsub:
Application.EnableEvents = True
End Sub

'fonction colonne J
Function colonne_j(ByVal Target As Range)
Dim Oldvalue As String
Dim Newvalue As String
Dim RetourChariot As String
RetourChariot = Chr(10)

Application.EnableEvents = True
On Error GoTo Exitsub

''multiple choix possible "services impactés" en colonne J

  If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
    GoTo Exitsub
  Else: If Target.Value = "" Then GoTo Exitsub Else
    Application.EnableEvents = False
    Newvalue = Target.Value
    Application.Undo
    Oldvalue = Target.Value
      If Oldvalue = "" Then
        Target.Value = Newvalue
      Else
        If InStr(1, Oldvalue, Newvalue) = 0 Then
            Target.Value = Oldvalue & ", " & RetourChariot & Newvalue
            Rows(ActiveCell.Row).EntireRow.AutoFit
      Else:
        Target.Value = Oldvalue
      End If
    End If
  End If

Exitsub:
Application.EnableEvents = True

End Function

Cordialement

 

[fanch55]

Salut à tous,
dans ce code, on peut étendre à toutes les colonnes avec validation du tableau,

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cel         As Range
Dim I           As Integer
Dim Oldvalue    As String
Dim Newvalue    As String

For Each Cel In Target
    If Not Intersect(Cel, [tableau_suivi_veille[#Data]]) Is Nothing Then
       ' Index de la ligne dans le tableau
        I = Cel.Row - [tableau_suivi_veille[#Headers]].Row
        Select Case True
       ' la ligne ci-dessous est à supprimer ou commenter pour traiter toutes les colonnes du tableau
        Case Intersect(Cel, [tableau_suivi_veille[Section]]) Is Nothing
        Case Cel = ""
        Case Intersect(Cel, Me.Cells.SpecialCells(xlCellTypeAllValidation)) Is Nothing
        Case Else
                Application.EnableEvents = False
                    Newvalue = Cel.Value
                        Application.Undo
                    Oldvalue = Cel.Value
                    Select Case True
                    Case Oldvalue = "": Cel = Newvalue
                    Case Not InStr(1, Oldvalue & ",", Newvalue & ",") > 0 ' ne pas trouver 1 dans 10
                        Cel = Oldvalue & ", " & vbLf & Newvalue
                        Cel.EntireRow.AutoFit
                    End Select
                Application.EnableEvents = True
        End Select
        With [tableau_suivi_veille[Date mise à jour]].Rows(I)
            Application.EnableEvents = False
                .Value = Now
                .Columns.AutoFit
            Application.EnableEvents = True
        End With

    End If
Next

End Sub

 

[petitbuzuc]

Un grand merci @Annach et @fanch55 et je m'excuse pour le délai de réponse. J'ai pu tester ce soir. j'ai opté pour le code pour fanch 55 car hyper compact !
un énorme merci à vous !

 

[petitbuzuc]

Salut à tous,
dans ce code, on peut étendre à toutes les colonnes avec validation du tableau,

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cel         As Range
Dim I           As Integer
Dim Oldvalue    As String
Dim Newvalue    As String

For Each Cel In Target
    If Not Intersect(Cel, [tableau_suivi_veille[#Data]]) Is Nothing Then
       ' Index de la ligne dans le tableau
        I = Cel.Row - [tableau_suivi_veille[#Headers]].Row
        Select Case True
       ' la ligne ci-dessous est à supprimer ou commenter pour traiter toutes les colonnes du tableau
        Case Intersect(Cel, [tableau_suivi_veille[Section]]) Is Nothing
        Case Cel = ""
        Case Intersect(Cel, Me.Cells.SpecialCells(xlCellTypeAllValidation)) Is Nothing
        Case Else
                Application.EnableEvents = False
                    Newvalue = Cel.Value
                        Application.Undo
                    Oldvalue = Cel.Value
                    Select Case True
                    Case Oldvalue = "": Cel = Newvalue
                    Case Not InStr(1, Oldvalue & ",", Newvalue & ",") > 0 ' ne pas trouver 1 dans 10
                        Cel = Oldvalue & ", " & vbLf & Newvalue
                        Cel.EntireRow.AutoFit
                    End Select
                Application.EnableEvents = True
        End Select
        With [tableau_suivi_veille[Date mise à jour]].Rows(I)
            Application.EnableEvents = False
                .Value = Now
                .Columns.AutoFit
            Application.EnableEvents = True
        End With

    End If
Next

End Sub

Ca marche super, un grand merci ! si tu as encore 2 min à me consacrer : peux tu juste m'éclairer sur un point : comment fais tu pour qu'on puisse sélectionner plusieurs valeurs en colonne J dans la liste déroulante ? car je ne vois pas dans le code de référence à la colonne J ! c'est juste pour monter en compétence

 

[fanch55]

Salut,
On ne fait pas référence à la colonne "J" mais à la colonne portant le nom Section du Tableau.
De ce fait, tu peux si tu le désires, déplacer celle-ci dans le tableau, le code fonctionnera toujours .

       ' la ligne ci-dessous est à supprimer ou commenter pour traiter toutes les colonnes du tableau
        Case Intersect(Cel, [tableau_suivi_veille[Section]]) Is Nothing 
               '--> si la cellule n'appartient pas à la colonne Section, on sort du select
        Case Cel = "" 
                '--> la cellule doit être renseignée
        Case Intersect(Cel, Me.Cells.SpecialCells(xlCellTypeAllValidation)) Is Nothing 
                '--> la suite ne se fera que si la cellule a une liste de validation

C'est dans la partie "Case Else" qu'on "cumule" les valeurs :
On sauvegarde la valeur entrée dans la variable NewValue.
On annule la saisie (undo) pour récupérer l'ancienne valeur .
Si on ne trouve pas déjà NewValue dans l'ancienne valeur,
on l'ajoute à l'ancienne valeur et on ajuste la hauteur de ligne .