couleur de texte d'un label ne s'execute pas (résolu)

debzac

XLDnaute Nouveau
Bonjour à tous et merci pour votre attention
Dans ce petit bout de vba j'ai demander que la couleur des label à créer soit blanc cependant il ne réagit pas alors qu'il marque bien le texte demandé. où est l'erreur ?
Merci

Sub couleur()
Dim i, max, val As Integer

On Error Resume Next

oterlabel
oterlacouleur

On Error Resume Next

max = Application.WorksheetFunction.max(Range("ad:ad"))

For i = 1 To Range("NatSal").Count
val = Sheets("carte").Cells(i, 30).Value
With Sheets("carte").Shapes(Range("NatSal")(i).Value)
.Fill.ForeColor.RGB = RGB(Application.WorksheetFunction.RoundDown(255 - (255 / max * val), 0), 0, 0) 'couleur
With Sheets("carte").Labels.Add(.Left + 0.5 * .Width, .Top + 0.25 * .Height, 100, 14)
.Caption = val
.ForeColor = vbWhite
.AutoSize = True
End With
End With
Next i
End Sub
 

Pièces jointes

  • carte nationalités xl.xlsm
    299.9 KB · Affichages: 20

job75

XLDnaute Barbatruc
Bonjour debzac, Bernard,

Pourquoi ne pas créer des Labels ActiveX ? Dans la Sub couleur() :
Code:
            With Sheets("carte").OLEObjects.Add(ClassType:="Forms.Label.1", Link:=False, _
                DisplayAsIcon:=False, Left:=.Left + 0.5 * .Width, Top:=.Top + 0.25 * .Height, Width:=8, Height:=8).Object
                .Caption = val
                .BackColor = vbBlack
                .ForeColor = vbWhite
                .Font.Size = 6
                .TextAlign = fmTextAlignCenter
            End With
Et bien sûr pour supprimer les Labels :
Code:
Sub oterlabel()
Dim o As OLEObject
    For Each o In Sheets("carte").OLEObjects
        If o.Name Like "Label*" Then o.Delete
    Next o
End Sub
A+
 

Discussions similaires

Réponses
0
Affichages
137

Statistiques des forums

Discussions
312 112
Messages
2 085 417
Membres
102 885
dernier inscrit
AISSOU