XL 2019 texte en filigrane dans une textbox

[pascal21]

bonjour à tous
dans un userform j'aimerais ne pas utiliser les labels pour indiquer le sujet de la textbox qui va avec (hum!!! déja pas tres clair)
donc, j'aimerais savoir si il est possible d'indiquer "NOM" par exemple dans un textbox pour que je sache ce qu'il faut y mettre?
merci

 

[patricktoulon]

Salut @patricktoulon , je connaissais cela avec un fichier Gif, l'inconvénient c'est que cela centre Verticalement et Horizontalement

a bon?????? : picturealignement !!!!!!!!!
par defaut ca te le met au centre mais c'est pas la seule option

 

[fanch55]

a bon?????? : picturealignement !!!!!!!!!
par defaut ca te le met au centre mais c'est pas la seule option

L'image est peut-être mise là où tu le précise, mais le texte reste immuablement au centre de l'aire ... C'est crispant ...

 

[patricktoulon]

a peut être
c'est vrai que si je veux le mettre a gauche j'ajoute des espaces
je regarderais ça de plus près
on va chercher comme d'hab

 

[patricktoulon]

re
bonjour @fanch55 finalement je ne suis pas allé chercher bien loin

Private Sub UserForm_Click()
    Dim chemin
    chemin = ThisWorkbook.Path & "\centre.jpg"
    With ActiveSheet.ChartObjects.Add(0, 0, 0.1, 0.1).Chart
        .Parent.ShapeRange.Line.Visible = msoFalse
        .Export chemin, "jpg"
        Label1.Picture = LoadPicture(chemin)
        .Parent.Delete
 
   End With
   Label1.Caption = " " & Label1.Caption & String(Int(Label1.Width), " ")
   Kill chemin
End Sub

je met un espace devant pour le margin et j'ajoute autant d'espaces que l"arrondi de son width

et même avec une chaine plus longue et un font size plus gros on change rien

Nous sommes d'accords pour dire que ça n'est pas très logique mais ca marche dans toutes les conditions

 

[patricktoulon]

@fanch55 et le voila transformé en fonction applicative
centre verticalement
à gauche ou pas
marginleft ou pas

Private Sub UserForm_Click()
    VerticalLabelTextAlign Label1, True, True' centré à gauche
'sans les argument centrré au centre verticalement et horizontalement
End Sub


Function VerticalLabelTextAlign(lab As MSForms.Label, Optional aGauche As Boolean = false, Optional margin As Boolean = False)
    Dim chemin
    chemin = ThisWorkbook.Path & "\centre.jpg"
    With ActiveSheet.ChartObjects.Add(0, 0, 0.1, 0.1).Chart
        .Parent.ShapeRange.Line.Visible = msoFalse
        .Export chemin, "jpg"
        Label1.Picture = LoadPicture(chemin)
        .Parent.Delete
    End With
    If aGauche Then Label1.Caption = String(Abs(margin), " ") & Label1.Caption & String(Int(Label1.Width), " ")
    Kill chemin
End Function

voila
patrick

 

[patricktoulon]

@fanch55
voilà cette fois si on a tout dans une fonction

' les délires de patricktoulon
'centrer verticalement le texte d'un label +alignement horizontal left,center,right

Private Sub CommandButton1_Click()
    VerticalLabelTextAlign Label1, aGauche:=True, margin:=True
End Sub

Private Sub CommandButton2_Click()
    VerticalLabelTextAlign Label1
End Sub

Private Sub CommandButton3_Click()
    VerticalLabelTextAlign Label1, aDroite:=True
End Sub

Function VerticalLabelTextAlign(lab As MSForms.Label, Optional aGauche As Boolean = False, Optional aDroite As Boolean = False, Optional margin As Boolean = False)
    Dim chemin, LargeChar&, lblTemp As Object, restelarge, Nb&
    chemin = ThisWorkbook.Path & "\centre.jpg"
    lab.Caption = Trim(lab.Caption)
    With ActiveSheet.ChartObjects.Add(0, 0, 0.05, 0.05).Chart
        .Parent.ShapeRange.Line.Visible = msoFalse
        .Export chemin, "jpg"
        Label1.Picture = LoadPicture(chemin)
        .Parent.Delete
    End With
    If aGauche Then lab.Caption = String(Abs(margin), " ") & Label1.Caption & String(Int(Label1.Width), " ")

    If aDroite Then
        Set lblTemp = lab.Parent.Controls.Add("Forms.Label.1")
        ' 3?? Configuration du Label temporaire
        lblTemp.Width = 300 ' on le met bien large sinon on risque le wrap si le text est plus long que les 60 points automatique de large a l'insertion
        Set lblTemp.Font = lab.Font ' on recupère le font et tout ses membres
        lblTemp.Caption = lab.Caption ' maintenant on met le texte en entier dans le label temporaire
        lblTemp.AutoSize = True 'cette fois ci oui on autosize
        restelarge = lab.Width - lblTemp.Width 'récupère la diférence du width
        lblTemp = "i" 'on met un caractère dans le label temporaire pas d'espace le calcul ne se fait pas sinon donc in "i"qui est un caractère pas trop large
        LargeChar = lblTemp.Width 'on recupère la 2d largeur du label temporaire
        Nb = restelarge / LargeChar ' on fait une simple division pour avoir le nombre de caractères
        lab.Caption = String(Nb, " ") & Label1.Caption 'on applique le string(" " au nombre NB
        lab.Parent.Controls.Remove lblTemp.Name 'suppression du label temporaire utilisé pour le calcul
    End If
    Kill chemin
End Function

 

[fanch55]

@fanch55
voilà cette fois si on a tout dans une fonction

Salut @patricktoulon ,
J'ai testé ta fonction ( corrigée car trop de label1 dans la fonction ... )
Cela ne fait pas du tout comme décrit ..... ???? ( Excel 2021 ???) 🤔

 

[patricktoulon]

Bonjour @fanch55
ajoute lab.wordwrap=false dans la fonction au debut
j'ai oublié de le dire

 

[fanch55]

Et voilà avec la TextBox de @patricktoulon...

Edit: fichier modifié pour une fonction générale de gestion du titre en TextBox_Change() et ComboBox_Change().

Salut @Dudu2
version que j'ai testée avec ton apport, pour Info .
Le filigrane peut être indiqué dans le Tag du Control, il sera pris en compte s'il n'est pas indiqué au SetFond

Le classeur corrigé est au post 83

 

[fanch55]

Bonjour @fanch55
ajoute lab.wordwrap=false dans la fonction au debut
j'ai oublié de le dire

Ah ben, ça m'étonnait aussi.
avec le wordwrap, c'est mieux sauf pour l'alignement à droite ....

 

[patricktoulon]

oui voila c'est pas parfait mais bon
tu a deux boutons font size pour tester la droite
je le redis c'est par parfait

 

[Nathe]

Bonjour le forum,

Pour moi, le problème est juste le centrage verticale, horizontalement pas de souci et sans trop de ligne de code et sans label, comme demandé initialement.

Le souci est juste le centrage vertical

Private Sub UserForm_Initialize()
    With TextBox1
        .TextAlign = fmTextAlignCenter
        .MultiLine = True
        .WordWrap = True
        .Height = 20
        .Text = "Votre texte ici"
        .EnterKeyBehavior = True
    End With
    CenterText
End Sub

Private Sub TextBox1_Change()
    CenterText
End Sub

Private Sub CenterText()
    Dim lineCount As Integer
    Dim maxLines As Integer
    Dim textboxHeight As Long
    Dim lineHeight As Long
    Dim spaceAbove As Long

    lineHeight = 15
    lineCount = UBound(Split(TextBox1.Text, vbCrLf)) + 1
    textboxHeight = TextBox1.Height
    maxLines = textboxHeight \ lineHeight
    If lineCount < maxLines Then
        spaceAbove = (maxLines - lineCount) / 2
        TextBox1.Text = String(spaceAbove, vbCrLf) & TextBox1.Text ' Ajoute des lignes vides au-dessus
    End If
End Sub

 

[TooFatBoy]

Bonjour,

Le souci est juste le centrage vertical

Pour le centrage vertical il y a une très vieille astuce qui consiste à mettre un gif d'un pixel transparent dans le label. 😉

 

[fanch55]

oui voila c'est pas parfait mais bon
tu a deux boutons font size pour tester la droite
je le redis c'est par parfait
Regarde la pièce jointe 1213298

Merci Pat, c'était par curiosité, toujours intéressant de voir ce que tu proposes . Bonne journée

 

[Nathe]

Bonjour,


Pour le centrage vertical il y a une très vieille astuce qui consiste à mettre un gif d'un pixel transparent dans le label. 😉

Bonjour, peut-être, mais le demandeur demandait sans Label de base