XL 2010 changer couleur de la font, lors de la colorisation de la cellule

[polyteis]

Bonjour
je viens de créer un tableau simple, qui reprend toutes les semaines d'une année.
J'ai répété sur l'ensemble des cellule le n° de la semaine ( écriture blanche ), donc invisible.
j'aimerai savoir comment opérer pour qu'automatiquement en :
coloriant la cellule, la font d'écriture soit noire

merci

 

[patricktoulon]

bonjour
si tu colorie la cellule avec la palette du menu ou du ruban ça n'est pas possible il te faut utiliser un dialog color
et c'est en vba donc xlsm et plus xlsx

 

[polyteis]

bonjour
tout d'abord merci,
comment fonctionne le diag color

 

[patricktoulon]

re
avant de savoir comment fonctionne le dialog color ayant un return il faudrait savoir quand a quel moment la cellule est coloriée

cela dit un exemple
dans le module de la feuille tu met ceci
tu a une palette couleur qui s'affiche tu choisie la couleur et si c'est blanc le font sera blanc sinon le font sera noir

Function GetColor()
    Dim lcolor As Long
    If Application.Dialogs(xlDialogEditColor).Show(2, 0, 0, 0) = True Then
        GetColor = ActiveWorkbook.Colors(2)
    End If
    ActiveWorkbook.ResetColors
End Function

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Dim C As Variant
    C = GetColor
    If C = "" Then Exit Sub
    If C = vbWhite Then Target.Font.Color = vbWhite Else Target.Font.Color = vbBlack
    Target.Interior.Color = IIf(C = vbWhite, xlNone, C)
    Cancel = True
End Sub

 

[Rouge]

Bonjour,

Essayez ceci, passez les cellules de votre choix avec une couleur, puis cliquez dans une autre cellule

cdlt

 

[job75]

Bonjour polyteis, patricktoulon, Rouge,

Voyez le fichier joint et cette macro :

Sub CouleurPolice()
'Menu Exécution => Réinitialiser pour arrêter la macro
Dim c As Range, coul&, coulpol&, t#
For Each c In ThisWorkbook.Sheets("semainier").[D5:BJ117] 'plage à adapter
    coul = c.Interior.Color
    coulpol = c.Font.Color
    If coul <> 16777215 And coulpol = 16777215 Then c.Font.ColorIndex = xlAutomatic
    If coul = 16777215 And coulpol <> 16777215 Then c.Font.Color = 16777215
Next
t = Timer + 1 'temporisation 1 seconde
While Timer < t And t < 86400: DoEvents: Wend 'boucle d'attente
CouleurPolice
End Sub

Elle est lancé à l'ouverture du fichier par cette macro dans ThisWorkbook :

Private Sub Workbook_Open()
Application.OnTime 1, "CouleurPolice"
End Sub

A+

 

[polyteis]

messieurs,

je tiens à vous remercier tous pour vos reponses,
je n'ai pas pu tester la version "couleur police(1)" de job75, car j'ai à l'ouverture une erreur.
les 2 autres solutions sont très ressemblantes.
encore merci

 

[job75]

je n'ai pas pu tester la version "couleur police(1)" de job75, car j'ai à l'ouverture une erreur.

C'est curieux, supprimez le fichier et téléchargez-le de nouveau.

Dans la macro la relance par l'instruction CouleurPolice crée une pile, ce qui alourdit la mémoire.

Pour l'éviter il vaut mieux une boucle Do/Loop, voyez ce fichier (2) :

Sub CouleurPolice()
'Menu Exécution => Réinitialiser pour arrêter la macro
Dim c As Range, coul&, coulpol&, t#
Do
    For Each c In ThisWorkbook.Sheets("semainier").[D5:BJ117] 'plage à adapter
        coul = c.Interior.Color
        coulpol = c.Font.Color
        If coul <> 16777215 And coulpol = 16777215 Then c.Font.ColorIndex = xlAutomatic
        If coul = 16777215 And coulpol <> 16777215 Then c.Font.Color = 16777215
    Next
    t = Timer + 1 'temporisation 1 seconde
    While Timer < t And t < 86400: DoEvents: Wend  'boucle d'attente
Loop
End Sub

 

[polyteis]

re
erreur d'exécution 1004
la méthode ontime de l'objet application a échoué

 

[polyteis]

debogage l'erreur est donnée pour la ligne en rouge

Private Sub Workbook_Open()
Application.OnTime 1, "CouleurPolice"
End Sub

 

[job75]

Chez moi la Workbook_Open ne beugue pas et il n'y a pas de raison qu'elle beugue.

Essayez peut-être avec Application.OnTime Now, "CouleurPolice".