XL 2013 labelou shapes et vice et versa

[patricktoulon]

Bonjour a tous
je voudrais ajouter un label (controls formulaire pas activeX)
il y a plusieurs methodes pour ajouter cet elements
j'en ai deux qui me destroy les neuronnes
en effet
si je passe par la classe shapes.addlabel
je ne trouve pas comment regler les font et alignement ni par textframe(2) ni autre

si je passe par la classe label
je retrouve un peu le moyen de regler mais il y a un truc qui me rend dingue
si je ne met pas un width 2 à 3 fois plus grand que la longeur de texte je me retrouve avec un texte aligné verticalement

et le pire dans tout ça et qui me rend encore plus perplexe c'est que dans l'exemple qui suit je règle le font.size du lab1
et c'est le lab2 qui reçoit ce paramètre alors que les deux objects sont bien distincts

un truc de fou je vous dis

j'ai courru voir le medecin il me confirme que tout va bien je fait donc appel à vous
Bon d'accords ce matin je me suis levé avec une légère douleur au lobe frontal mais tout de même

Sub testbizare()
    Dim Lab2, Lab1

    Set Lab1 = ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, 150, 150, 15, 15)
    Lab1.TextFrame.Characters.Text = "AB"
    ' Lab1.TextFrame.Characters(1, 2).Font.Size = 30
    'Lab1.TextFrame.AutoSize = True

    'si je debloque les lignes ci dessus  le lab1 n'est pas modifié  c'est le lab2 qui va l'etre
    ' alors qu'ensuite  à la lecture  des propertie du lab2 les propertie donne c'elle par defaut


    With ActiveSheet
        Set Lab2 = .Labels.Add(100, 100, 15, 15)
        Lab2.Characters.Text = "AB"
        Debug.Print "texte du label :" & .Shapes(Lab2.Name).TextFrame.Characters.Text
        Debug.Print "couleur du texte :" & .Shapes(Lab2.Name).TextFrame.Characters(1, 2).Font.Color
        Debug.Print "police du texte :" & .Shapes(Lab2.Name).TextFrame.Characters(1, 2).Font.Name
        Debug.Print "taille  de la police du texte :" & .Shapes(Lab2.Name).TextFrame.Characters(1, 2).Font.Size

        'ici ca plante j'ai essayé toute les formes  (textframe /2 characters, textrange,etc.... rien de rien
        Debug.Print .Shapes(Lab2.Name).TextFrame.Text.AutoSize
        Debug.Print .Shapes(Lab2.Name).TextFrame.TextRange.HorizontalAlignment
    End With
End Sub

c'est moi ou bien ?

 

[patricktoulon]

bon ben c'est moi ,
cela dit reste a savoir pourquoi je ne peux régler les propertie avec le premier
d'ailleurs meme mano mano tout est grisé
(pourquoi) est ce bien le même type d'element ou pas

 

[Compte Supprimé 979]

Salut Patrick

Si tu utilises l'enregistreur de macro, voici ce qu'il faut apparemment faire

    Dim Lab1 As Shape
    Set Lab1 = ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, 150, 150, 15, 15)
    Lab1.TextFrame.Characters.Text = "AB"
    Lab1.TextFrame2.TextRange.Characters(1, 2).Font.Size = 30
    Lab1.TextFrame.AutoSize = True

A+

 

[patricktoulon]

bonjour bruno
c'est pas tant le ActiveSheet.Shapes.AddLabel qui mepose probleme
d'ailleurs je maitrise a peu près bien la manipulation des properties par différente collections

c'est plutot le activesheet.label.add qui me pose problème
et c'est lui que je préfère car il n'y a pas de margin
autrement dit j'inscrit "AB" dedans avec une taile 15*15 et ça rentre

tandis que ActiveSheet.Shapes.AddLabel il faut le autosize sinon c'est aligné vertical et en plus le autosize agrandi le width ce n'est donc plus 15*15

 with activesheet
 Set Lab2 = .Labels.Add(150, 150, 15, 15)
        Lab2.Characters.Text = "AB"
        Lab2.Name = "toto"

        Lab2.Characters(1, 2).Font.Color = vbRed                    'ne fonctionne pas
        .DrawingObjects(Lab2.Name).Font.Color = vbRed               'ne fonctionne pas
        Lab2.Fill.ForeColor.RGB = vbRed                             'ne fonctionne pas
        .DrawingObjects("toto").Font.Name = "arial"                 'ne fonctionne pas
        .Shapes("toto").TextFrame.Text.Font.Name = "arial"          'ne fonctionne pas
        .Shapes("toto").Characters(1, 2).Font.Name = "arial"        'ne fonctionne pas
        .Shapes("toto").TextFrame.Characters(1, 2).Font.Size = 8    'ne fonctionne pas


    End With

avec shapes.addlabel je gère il n'y a pas de soucis et de différente manières en plus comme tu peux le voir ci dessous

 With ActiveSheet
        Set Lab1 = ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, 100, 100, 15, 15)
        Lab1.TextFrame.Characters.Text = "AB"

        'Lab1.TextFrame.AutoSize = True

        .DrawingObjects(Lab1.Name).Font.Name = "arial"              ' ou ' Lab1.TextFrame.Characters(1, 2).Font.Name = "arial"

        .DrawingObjects(Lab1.Name).Font.Size = 8                    ' ou ' Lab1.TextFrame.Characters(1, 2).Font.Size = 8

        .DrawingObjects(Lab1.Name).Font.Color = vbRed               ' ou ' Lab1.TextFrame.Characters(1, 2).Font.Color = vbRed    'ne fonctionne pas

        .DrawingObjects(Lab1.Name).Interior.Color = vbBlue          ' ou ' Lab1.Fill.ForeColor.RGB = vbBlue

        .DrawingObjects(Lab1.Name).HorizontalAlignment = xlHAlignLeft     ' ou ' Lab1.TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignLeft

        .DrawingObjects(Lab1.Name).VerticalAlignment = xlVAlignCenter     ' ou ' ???????????
end with

 

[Compte Supprimé 979]

Re,

Désolé je n'ai pas tout compris ton problème alors

Quand tu crées ton étiquette = formulaire, tu n'as aucune possibilité de modifier ce qui est dedans
Donc du coup, cela me semble logique que tu ne puisse pas en VBA... non

 

[patricktoulon]

re
ben oui c'est ça le problème
pourtant c'est bien celui là qu'il me faut a moins que l'on puisse régler le margin avec le shapes.label.add
ce qui me permettrait je suppose de faire sauter le autosize et le garder à 15*15 de hauteur/largeur

 

[patricktoulon]

re
allez OK c'est tout bon avec le shapes.label.add on a le margin(left et right) qui sont ok

Sub test_shapes_Addlabel()
    Dim Lab2, Lab1

    With ActiveSheet
        Set Lab1 = ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, 100, 100, 15, 15)
        Lab1.TextFrame.Characters.Text = "AB"
        Lab1.TextFrame.MarginLeft = 0
        Lab1.TextFrame.MarginRight = 0
       
        .DrawingObjects(Lab1.Name).Font.Name = "arial"              ' ou ' Lab1.TextFrame.Characters(1, 2).Font.Name = "arial"

        .DrawingObjects(Lab1.Name).Font.Size = 8                    ' ou ' Lab1.TextFrame.Characters(1, 2).Font.Size = 8

        .DrawingObjects(Lab1.Name).Font.Color = vbRed               ' ou ' Lab1.TextFrame.Characters(1, 2).Font.Color = vbRed    'ne fonctionne pas
     
        .DrawingObjects(Lab1.Name).HorizontalAlignment = xlHAlignCenter     ' ou ' Lab1.TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignLeft

        .DrawingObjects(Lab1.Name).VerticalAlignment = xlVAlignCenter     ' ou ' ???????????
    End With

End Sub

voila la j'ai le meme résultat qu'avec l'autre sauf que je peux modifier les properties(font,forecolor,etc....
et le autosize bye bye!!
je maîtrise donc les dimensions

 

[Compte Supprimé 979]

Merci Patrick

Avec toi aussi nous en apprenons tous les jours

Je dormirais moins bête ce soir (ou pas)

 

[patricktoulon]

ben je suis un peu un furieux quand je cherche je lache rien

en plus dans le code il a les deux versions de méthodes shapes et drawingobjects
c'est quand meme plus simple avec la collection drawingobjects non?
voila maintenant j'ai les chiffre bien placée dans le fond de mon horloge V 3 du nom de Luxar
c'est pas de la précision ça

 

[patricktoulon]

ca me donne une idée ça pour me faire un convertisseur columnwidth to width
d'autant plus que l'astuce existe deja avec les labels dans un userform

 

[dysorthographie]

Bonsoir Patrick et bonsoir BrunoM45,
je ne sais pas si tu as l'intension de permettre aux utilisateurs de modifier l 'apparence de tes shapes?

Type Font
    FontName As String
    FontBold As Boolean
    FontItalic As Boolean
    FontSize As Single
    Strikethrough As Boolean
End Type
Public Property Get GetFont() As Font
With CreateObject("MSComDlg.CommonDialog")
    .showfont
       GetFont.FontBold = .FontBold
       GetFont.FontItalic = .FontItalic
       GetFont.FontName = .FontName
       GetFont.FontSize = .FontSize
       GetFont.Strikethrough = .FontStrikethru
End With
End Property
Public Property Get GetColor() As OLE_COLOR
Dim C As OLE_COLOR
With CreateObject("MSComDlg.CommonDialog")
    .CancelError = True
    On Error Resume Next
    .ShowColor
    If Err Then
       GetColor = -1
    Else
       GetColor = .Color
    End If
    On Error GoTo 0
End With
End Property
Property Get GetFichier(Optional Filter = "*.*") As String
With CreateObject("MSComDlg.CommonDialog")
    .Filter = Filter
    .ShowOpen
   GetFichier = .Filename
End With

End Property

Sub test()
Dim Fich As String, Fon As Font, Coul As OLE_COLOR
Fich = GetFichier("Image ( *.jpg)|*.jpg|Image ( *.gif)|*.gif|Image (*.bmp)|*.bmp")
Fon = GetFont
Coul = GetColor
End Sub

 

[patricktoulon]

re
oui des boites de dialog si tu veux
mais la fonction créant le cadrant est justement argumentée pour ca
ca se decide au depart dans la sub de test de lancement

apres il y a beaucoup de chose possible a faire je me demande si c'est pas un peu trop pour quelque chose de dynamique
il est pas classe mon cadran ???

 

[dysorthographie]

Je comprends moi j'ai défini des conténère que je renseigne d'où l'intérêt d'interface !

 

[patricktoulon]

heu pour info le cadran que tu vois plus haut c'est pas une image
c'est bien des shapes d'un bout à l'autre
en ait je construit tout

 

[dysorthographie]

Oui j'avais compris c'est un super boulot