XL 2016 Supprimer la retour a la ligne dans une validation de données

treza88

XLDnaute Occasionnel
Bonjour a tous,

Est il possible de supprimer la retour a la ligne dans une validation de données créer en VBA.
Je voudrais que le texte qui s'affiche soit sur la même ligne pour que ce soit plus lisible.
Ou alors augmenter le nombre de caractères de la première ligne.

Si quelqu'un a la solution ou alors s'il sait que ce n'est pas possible.
Merci d'avance
 

treza88

XLDnaute Occasionnel
Merci pour ton intervention Fred0o,
Voici un fichier qui correspond a mes besoins.
Si on clique sur le 10 en dessous de Marseille une infobulle apparait avec en titre "Marseille" et en dessous "manteau blanc viscose occasion".
C'est ce texte "manteau blanc viscose occasion" que je voudrais sur une seule ligne.
En espérant être clair.
 

Pièces jointes

  • Validation de données.xlsm
    19 KB · Affichages: 23

job75

XLDnaute Barbatruc
Bonjour treza88, Fred0o,

Voyez le fichier joint et cette macro :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim DernLign&, x$
    DernLign = Range("F" & Rows.Count).End(xlUp).Row
    Range("E9:Z" & DernLign).Cells.Interior.ColorIndex = xlNone
    Shapes("ZoneTexte 1").Visible = False
    If Not Application.Intersect(Target(1), Range("E9:W" & DernLign)) Is Nothing Then
        Application.Intersect(Target(1).EntireRow, Range("E9:W" & DernLign)).Interior.ColorIndex = 34
        x = Cells(7, Target.Column)
        If x <> "" Then
            With Shapes("ZoneTexte 1") 'nom à adapter
                .TextFrame.Characters.Text = x & vbLf & Cells(Target.Row, "F")
                .TextFrame.Characters.Font.Bold = True 'gras
                .TextFrame.Characters(Len(x) + 1).Font.Bold = False
                .TextFrame.AutoSize = True
                .Top = Target(2, 1).Top + 5
                .Left = Target.Left + 10
                .Visible = True
            End With
        End If
    End If
End Sub
La zone de texte permet d'utiliser les formats que l'on veut.

A+
 

Pièces jointes

  • Validation de données(1).xlsm
    23.4 KB · Affichages: 8
Bonjour treza88, fred0o, job75, le forum

Ok merci pour ta solution qui peut me convenir, mais il y a t'il un moyen de garder la même présentation "Marseille" en gras et l'autre texte sur une ligne en dessous en écriture simple?
treza88 , les commentaires autorisent pas mal de choses en modifiant un peu le code de Fred0o 👀.

Bien cordialement, @+

VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim DernLign As Integer
    DernLign = Range("F" & Rows.Count).End(xlUp).Row
    Range("E9:Z" & DernLign).Cells.Interior.ColorIndex = xlNone
    Dim cbag As Variant
    cbag = Range("H16")
    If Not Application.Intersect(Target(1, 1), Range("E9:Z" & DernLign)) Is Nothing Then
        Application.Intersect(Target(1, 1).EntireRow, Range("E9:Z" & DernLign)).Interior.ColorIndex = 34
        Range("C9:Z" & DernLign).ClearComments
        With Selection
            .AddComment
            .Comment.Visible = True
            .Comment.Text Text:=Range(Split(Selection.Address, "$")(1) & "7") & " : " & Chr(10) & Range("F" & Split(Selection.Address, "$")(2))
            If Len(Range(Split(Selection.Address, "$")(1) & "7")) > 0 Then
                With .Comment.Shape.TextFrame.Characters(Start:=1, Length:=Len(Range(Split(Selection.Address, "$")(1) & "7")) + 3).Font
                    .Name = "Matura MT Script Capitals"
                    .Bold = True
                    .Size = 20
                End With
            End If
        .Comment.Shape.Select
        End With
        Selection.AutoSize = True
        Target.Select
    End If
End Sub
 
re, le fil

treza88 , j'ai ajouté la couleur de fond en citron vert, la couleur par défaut n'est pas terrible.
tu peux la choisir parmi les 56 couleurs de base.

56 couleurs de base.png


Cordialement, @+
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim DernLign As Integer
    DernLign = Range("F" & Rows.Count).End(xlUp).Row
    Range("E9:Z" & DernLign).Cells.Interior.ColorIndex = xlNone
    Dim cbag As Variant
    cbag = Range("H16")
    If Not Application.Intersect(Target(1, 1), Range("E9:Z" & DernLign)) Is Nothing Then
        Application.Intersect(Target(1, 1).EntireRow, Range("E9:Z" & DernLign)).Interior.ColorIndex = 34
        Range("C9:Z" & DernLign).ClearComments
        With Selection
            .AddComment
            .Comment.Visible = True
            .Comment.Text Text:=Range(Split(Selection.Address, "$")(1) & "7") & " : " & Chr(10) & Range("F" & Split(Selection.Address, "$")(2))
            If Len(Range(Split(Selection.Address, "$")(1) & "7")) > 0 Then
                With .Comment.Shape.TextFrame.Characters(Start:=1, Length:=Len(Range(Split(Selection.Address, "$")(1) & "7")) + 3).Font
                    .Name = "Matura MT Script Capitals"
                    .Bold = True
                    .Size = 20
                End With
            End If
        .Comment.Shape.Select
        End With
        With Selection
            .AutoSize = True
            .Interior.ColorIndex = 43
        End With
        Target.Select
    End If
End Sub
 

treza88

XLDnaute Occasionnel
Merci JobB75 et Yeahou,
Pour vos infos supplémentaires et très complètes, avec ça je suis armé pour trouver la solution qui me convient.
Il faudra quand même que je décrypte vos codes pour tout comprendre, mais ça devrait aller.
Encore merci a vous 3.
 

Discussions similaires