XL 2021 ListBox1 : format texte date et enregistrement sans ma cellule

[Usine à gaz]

Bonjour à toutes et à tous
J'espère et je vous souhaite de belles fêtes de fin d'année ...

LOL y'avait longtemps

Je n'arrive pas à faire fonctionner ma ListBox1 comme je le voudrais Grrr !
Contexte
au clic cellule "I7"
la ListBox1 (plage B9:B31) s'affiche et je sélectionne mon affectation
au clic sur la sélection, la date/h/mn et ma sélection s'affichent dans la cellule "K6" avant le texte déjà existant

Besoin1
Est-il possible d'avoir la date en gras et soulignée ?
exemple
27.12.23 15:22:58 : Mandat groupt -

Besoin2
si je fais 2 affectations ou + le même jour, j'obtiens :
exemple
27.12.23 15:22:58 : Mandat groupt - 27.12.23 15:13:30 : Hors cible - 27.12.23 15:11:54 : RDV Fait -

J'aimerais que, si plusieurs affectations sont faites le même jour :
le ou les commentaires précédents la dernière affection n'aient pas de date mais juste les heures et minutes
exemple
27.12.23 15:22:58 : Mandat groupt - 15:13:30 : Hors cible - 15:11:54 : RDV Fait -

J'aurais bien besoin de vos lumières
Auriez-vous les bons codes ?
En cas, je joins le petit fichier test.

Grand merci à toutes et à tous,
Je continue mes recherches...

 

[Efgé]

Bonjour
Peux-tu le faire "à la main"?
Non ? Alors....
Ce qui m"inquiéte ce n'est pas que tu pauses la question (bien qu'avec plus de 7 000 posts cela soit pour le moins surprenant), c'est que certains viendrons te proposer des solutions qui ne feront qu'agraver ton fichier....
Cordialement

 

[job75]

Bonjour Lionel, le fil,

Je ne vois pas l'intérêt des Application.EnableEvents mais bon :

Private Sub ListBox1_Change()
  If ListBox1 Like ("…*") Or ListBox1 = ("") Then Exit Sub
  With ActiveCell.Offset(0, 2)
    .Value = Replace(.Value, Format(Date, "dd.mm.yy "), "")
    .Value = Format(Now, "dd.mm.yy hh:mm:ss") & " : " & ListBox1 & " - " & .Value
    .Font.Bold = False
    .Font.Underline = xlUnderlineStyleNone
    .Characters(1, 8).Font.Bold = True
    .Characters(1, 8).Font.Underline = xlUnderlineStyleSingle
  End With
  Cells(ActiveCell.Row, 1).Select
  Unload Me
  Application.EnableEvents = True
End Sub

A+

 

[Usine à gaz]

Bonjour Gérard ,

Je te remercie pour ton retour.
Comme d'habitude, c'est nickel.
Un grand merci à toi


edit : Bonjour Efgé, Bonjour Patrick

 

[job75]

Non ce n'était pas nickel, j'avais mis Date à la place de Now, c'est corrigé.

 

[job75]

Par ailleurs quand il y a plusieurs dates différentes il paraît logique de toutes les souligner :

Private Sub ListBox1_Change()
  If ListBox1 Like "…*" Or ListBox1 = "" Then Exit Sub
  Dim i%
  With ActiveCell.Offset(0, 2)
    .Value = Replace(.Value, Format(Date, "dd.mm.yy "), "")
    .Value = Format(Now, "dd.mm.yy hh:mm:ss") & " : " & ListBox1 & " - " & .Value
    .Font.Bold = False
    .Font.Underline = xlUnderlineStyleNone
    For i = 1 To Len(.Value) - 7
      If Mid(.Value, i, 8) Like "##.##.##" Then
        .Characters(i, 8).Font.Bold = True
        .Characters(i, 8).Font.Underline = xlUnderlineStyleSingle
        i = i + 7
      End If
    Next
  End With
  Cells(ActiveCell.Row, 1).Select
  Unload Me
  Application.EnableEvents = True
End Sub

 

[Usine à gaz]

Merci gérard
C'est parfait.
Bonne nuit,

 

[Usine à gaz]

Bonjour job75 (Gérard) , Bonjour Efgé ,
Bonjour à toutes et à tous

Je reviens sur le fil pour un beson que je n'avais pas identifié dans ma demande initiale et que j'ai réussi à résoudre avec l'aide du code de Gérard dans "affecte".
Besoin 3 : saisir directement un commentaire
Quand je sélectionne "Autre - voir commentaires" dans "affecte - LisBox1" : ouverture de "Commentaire" pour saisie directe du commentaire.

Il y a peut-être (certainement lol) mieux à coder.
Pour info et peut-être modification des codes "affecte et commentaire", je joins le fichier test.

 

[job75]

Bonjour Lionel, le forum,

Tu as fait un UserForm pour entrer un commentaire en manuel mais il n'est pas nécessaire.

La macro complétée pour positionner le curseur où il faut dans la cellule en colonne K :

Private Sub ListBox1_Change()
  If ListBox1 Like "…*" Or ListBox1 = "" Then Exit Sub
  Dim manuel As Boolean, i%
  If ListBox1 = "Autre - voir commentaires" Then manuel = True
  With ActiveCell.Offset(0, 2)
    .Value = Replace(.Value, Format(Date, "dd.mm.yy "), "")
    .Value = Format(Now, "dd.mm.yy hh:mm:ss") & " : " & IIf(manuel, "", ListBox1) & " - " & .Value
    .Font.Bold = False
    .Font.Underline = xlUnderlineStyleNone
    For i = 1 To Len(.Value) - 7
      If Mid(.Value, i, 8) Like "##.##.##" Then
        .Characters(i, 8).Font.Bold = True
        .Characters(i, 8).Font.Underline = xlUnderlineStyleSingle
        i = i + 7
      End If
    Next
    If manuel Then
        .Cells.Select
        CreateObject("WScript.Shell").SendKeys "{F2}{LEFT " & Len(.Cells) - 20 & "}" 'positionne le curseur dans la cellule
    Else
        Cells(ActiveCell.Row, 1).Select
    End If
  End With
  Unload Me
  Application.EnableEvents = True
End Sub

A+

 

[Usine à gaz]

Bonjour Gérard
Merci encore une fois lol

 

[job75]

Je dois dire que je suis assez content : c'est la 1ère fois que je pilote l'entrée de données en un endroit précis d'une cellule.

 

[Usine à gaz]

Re-Gérard
J'en suis également content pour toi.
Et encore merci d'être là.
Mais lol ... J'ai encore avancé sur le sujet (je sens que ça va chauffer pour moi lol
Je mettrai le fichier quand j'aurais terminé...

 

[job75]

Dans la foulée voici un petit gadget avec le Zoom :

Private Sub Worksheet_SelectionChange(ByVal R As Range)
If Intersect(R, Range("k7:k7")) Is Nothing Then
    ActiveWindow.Zoom = 100
    ActiveWindow.ScrollColumn = 1
Else
    ActiveWindow.Zoom = 180
    ActiveWindow.ScrollColumn = 5
End If
If Not Intersect(R, Range("i7:i7")) Is Nothing Then affecte.Show
End Sub

 

[Usine à gaz]

Merci Gérard

 

[job75]

As-tu compris que dans la macro ListBox1_Change j'ai dû déplacer Application.EnableEvents = True
pour que le Zoom puisse fonctionner ?

Bonne nuit?