Discussion :

[dmoluc]

Bonjour à tous

Je voudrais savoir s'il est possible de combiner le coloriage de la cellule et la couleur de police ; je voudrais que les deux soit identiques
je colorie l'intérieur de la cellule avec une fonction

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Selection.Interior.Color = ShowColor

je pourrais bien sur répéter l’opération pour la police mais ça va devenir fastidieux

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Selection.Font.Color = ShowColor

L'idéal serait de faire les deux à la fois mais c'est au delà de mes compétences

Merci pour votre aide

cordialement

Didier

[Philippe Tulliez]

Bonjour,
C'est faisable mais si tu mets le même code couleur à la fonte et à la cellule, tu auras un problème de lisibilité

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 Dim showcolor As Long
 Dim rng As Range: Set rng = Selection
 showcolor = vbRed
 With rng
 .Interior.color = showcolor
 .Font.color = showcolor
 End With

Tu peux essayer avec ce code mais je ne te garanti pas que cela fonctionnera avec tous les codes RGB. Je n'ai pas le temps de faire des tests plus poussés. Voir le lien donné hier concernant le didacticiel sur les codes RGB

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 Dim showcolor As Long
 Dim rng As Range: Set rng = Selection
 showcolor = vbYellow
 With rng
 .Interior.color = showcolor
 .Font.color = showcolor - 255 ^ 2 * 255 ^ 1
 End With

[EDIT]
Lien peut-être intéressant pour calculer le contraste automatiquement

[dmoluc]

merci pour ce petit code mais je n'arrive pas à le modifier pour afficher la palette de choix de couleur "choseColor" pour le moment ça colorie les cellules en noir uniquement
voici son code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Declare Function ChooseColor Lib "comdlg32.dll" Alias _
    "ChooseColorA" (pChoosecolor As ChooseColor) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Type ChooseColor
         lStructSize As Long
         hwndOwner As Long
         hInstance As Long
         rgbResult As Long
         lpCustColors As String
         flags As Long
         lCustData As Long
         lpfnHook As Long
         lpTemplateName As String
End Type

ça c'est le code de showcolor

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Private Function showcolor() As Long
         Dim ChooseColorStructure As ChooseColor
         Dim Custcolor(16) As Long
         Dim lReturn As Long
         ChooseColorStructure.lStructSize = Len(ChooseColorStructure)
         ChooseColorStructure.hwndOwner = FindWindow("XLMAIN", _
            Application.Caption)
         ChooseColorStructure.hInstance = 0
         ChooseColorStructure.lpCustColors = StrConv(CustomColors, _
            vbUnicode)
         ChooseColorStructure.flags = 0
         If ChooseColor(ChooseColorStructure) <> 0 Then
             showcolor = ChooseColorStructure.rgbResult
             CustomColors = StrConv(ChooseColorStructure.lpCustColors, _
               vbFromUnicode)
         Else
             showcolor = -1
         End If
     End Function

merci pour votre aide

[Philippe Tulliez]

Bonjour,
Je suppose que tu utilises une API et ne la connaissant pas, je ne sais pas t'aider.
Je me demande si tu ne te compliques pas la vie.
Il m'a semblé à la lecture de tes différents posts que tu voulais colorier un planning avec des couleurs différentes suivant, si je me souviens bien un nom de chantier ou de travaux à effectuer.
Je crois qu'il est beaucoup plus simple mais je peux me tromper de définir dans une feuille paramètres un tableau avec le nom des chantiers et la couleur que tu veux leurs attribuer.
Ainsi, tu es indépendant de ton code et tu pourras à tout instant modifier la couleur parce-que demain le vert ne te convient plus et tu le remplaces par du rouge et ce sans modifier ton code VBA.
Cest toujours comme cela que je travaille. Un maximum de paramètres dans mon classeur Excel et un minium de code VBA. Que ce soit pour le changement de propriétés ou de fichiers à transférer.
Je crée des procédures qui vont chercher les paramètres dans une ou plusieurs cellules et le tour est joué.
Si tu veux rendre ton projet pérenne et t'éviter des heures de recherches et de maintenance dans plusieurs mois et t'éviter de te brouiller avec tes proches, je crois que c'est la voie à adopter.
Je joins un petit fichier qui illustre mes propos. Bien sûr, je ne gère pas les dates et cela n'a rien à voir avec ce que tu fais actuellement mais cela peut te donner des idées.
Je suis convaincu que ton projet bien pensé pourrait tenir en moins de 9 procédures et être modifiable à souhait en remplaçant simplement des valeurs dans Excel.
Evidemment, cela demande de lire quelques tutos, prendre un papier et repenser le projet mais ce ne sera pas du temps perdu sinon ton projet risque de devenir une usine à gaz.
Dans le code ci-dessous, il y a 2 plages nommées dont un tableau dbPlanning et pdbColor

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Option Explicit
Sub Lecture()
 Dim r As Long, c As Long
 Dim rng As Range: Set rng = Range("dbPlanning") '  Tableau où se trouve le planning
 ' Table où se trouve le nom des projets avec leurs couleurs respectives
 Dim rngColor As Range: Set rngColor = Range("pdbColor")
 Dim cColor As Range, Pos As Byte
 Dim Projet As String
 Dim colorInt As Long, colorFont As Long
 
 ' Commence à la ligne 2 du tableau (Ligne 1 = Titre)
 Debug.Print rng.Address
 With rng
  For r = 2 To .Rows.Count
   Projet = .Cells(r, 1) ' Lit le nom du projet
   ' Affecte aux variables couleurs
   ' la propriété couleur (Font & Interior) du projet
   ' lu dans les paramètres (pdbColor)
   Set cColor = rngColor(Application.WorksheetFunction.Match(Projet, rngColor, 0))
   colorInt = cColor.Interior.Color:  colorFont = cColor.Font.Color
   For c = 2 To .Columns.Count
    ' Commence à la colonne 2 du tableau (Colonne 1 contient matière)
    With .Cells(r, c)
     If UCase(.Value) = "X" Then
      .Interior.Color = colorInt: .Font.Color = colorFont
     End If
    End With
   Next c
  Next r
 End With
End Sub

[dmoluc]

Merci Corona pour ton aide
en fait je ne cherche pas particulièrement à faire un planning "sans problème" car celui là je l'ai déjà donner à mes collègues. Juste quelques macros pour effacer automatiquement ou pour rajouter des données dans les bibliothèques, tout le reste est fait avec des formules, quand au coloriage des cellule, j'utilise bêtement une mise en forme conditionnelle en mettant à la main une valeur dans chaque cellule que je veux colorier.
Si je me suis lancé dans le VBa en créant du même coup une usine à gaz c'est pour essayer d'en apprendre un peu plus sur son fonctionnement et ne pas rester bloquer à la macro automatique créer par excel. Je suppose donc qu'il est un peu normal que je fasse de multiples bévues car ce n'est que le deuxième classeur que je traite de la sorte ; le premier était plus simple car ce n'était que des opérations arithmétiques.
Bien sur il m'a fallu beaucoup d'aide et des dizaines d'heures de lectures sur le net mais la programmation du coloriage des cellules est presque achevée : il me manque simplement de trouver comment faire pour avoir la même couleur de police et de remplissage et encore ce n'est pas vraiment une obligation.
J'ai aussi réussi quelques améliorations sur les autres feuilles du classeur sans trop de problème, car pas de dates pour m'embêter.

Il est certain que dans mes futurs projets je tiendrais compte de tes conseils car je n'ai pas non plus envie de passer des heures et des heures à chercher à faire des choses que je ne connais pas, hélas si je ne les fais jamais, je ne saurais jamais les faire. C'est pour cela que je profite de mon temps libre pour me lancer dans les usines à Gaz.
Je sais aussi que je n'ai pas l'esprit simple et que j'aime bien être compliquer et si je reste dans mon coin je ne m'améliorerai jamais. Je remercie donc toute l'équipe du forum pour son aide et ces excellent conseils

pour exemple dans ce même planing j'ai buté sur une sommeprod avec des divisions que je n'ai pas su faire et voilà ce que cela à donner en ligne 38 simplement pour avoir les recettes journalières

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=SI(ET(SOMME(K6:K36)=0;SOMME(L6:L36)=0);"";SOMME(SI(ET(K6>0;L6="");$B$6/$E$6/2;SI(ET(K6="";L6>0);$B$6/$E$6/2;SI(ET(K6>0;L6>0);$B$6/$E$6)));SI(ET(K7>0;L7="");$B$7/$E$7/2;SI(ET(K7="";L7>0);$B$7/$E$7/2;SI(ET(K7>0;L7>0);$B$7/$E$7)));SI(ET(K8>0;L8="");$B$8/$E$8/2;SI(ET(K8="";L8>0);$B$8/$E$8/2;SI(ET(K8>0;L8>0);$B$8/$E$8)));SI(ET(K9>0;L9="");$B$9/$E$9/2;SI(ET(K9="";L9>0);$B$9/$E$9/2;SI(ET(K9>0;L9>0);$B$9/$E$9)));SI(ET(K10>0;L10="");$B$10/$E$10/2;SI(ET(K10="";L10>0);$B$10/$E$10/2;SI(ET(K10>0;L10>0);$B$8/$E$10)));SI(ET(K11>0;L11="");$B$11/$E$11/2;SI(ET(K11="";L11>0);$B$11/$E$11/2;SI(ET(K11>0;L11>0);$B$11/$E$11)));SI(ET(K12>0;L12="");$B$12/$E$12/2;SI(ET(K12="";L12>0);$B$12/$E$12/2;SI(ET(K12>0;L12>0);$B$12/$E$12)));SI(ET(K13>0;L13="");$B$13/$E$13/2;SI(ET(K13="";L13>0);$B$13/$E$13/2;SI(ET(K13>0;L13>0);$B$13/$E$13)));SI(ET(K14>0;L14="");$B$14/$E$14/2;SI(ET(K14="";L14>0);$B$14/$E$14/2;SI(ET(K14>0;L14>0);$B$14/$E$14)));SI(ET(K15>0;L15="");$B$15/$E$15/2;SI(ET(K15="";L15>0);$B$15/$E$15/2;SI(ET(K15>0;L15>0);$B$15/$E$15)));SI(ET(K16>0;L16="");$B$16/$E$16/2;SI(ET(K16="";L16>0);$B$16/$E$16/2;SI(ET(K16>0;L16>0);$B$16/$E$16)));SI(ET(K17>0;L17="");$B$17/$E$17/2;SI(ET(K17="";L17>0);$B$17/$E$17/2;SI(ET(K17>0;L17>0);$B$17/$E$17)));SI(ET(K18>0;L18="");$B$18/$E$18/2;SI(ET(K18="";L18>0);$B$18/$E$18/2;SI(ET(K18>0;L18>0);$B$18/$E$18)));SI(ET(K19>0;L19="");$B$19/$E$19/2;SI(ET(K19="";L19>0);$B$19/$E$19/2;SI(ET(K19>0;L19>0);$B$19/$E$19)));SI(ET(K20>0;L20="");$B$20/$E$20/2;SI(ET(K20="";L20>0);$B$20/$E$20/2;SI(ET(K20>0;L20>0);$B$20/$E$20)));SI(ET(K21>0;L21="");$B$21/$E$21/2;SI(ET(K21="";L21>0);$B$21/$E$21/2;SI(ET(K21>0;L21>0);$B$21/$E$21)));SI(ET(K22>0;L22="");$B$22/$E$22/2;SI(ET(K22="";L22>0);$B$22/$E$22/2;SI(ET(K22>0;L22>0);$B$22/$E$22)));SI(ET(K23>0;L23="");$B$23/$E$23/2;SI(ET(K23="";L23>0);$B$23/$E$23/2;SI(ET(K23>0;L23>0);$B$23/$E$23)));SI(ET(K24>0;L24="");$B$24/$E$24/2;SI(ET(K24="";L24>0);$B$24/$E$24/2;SI(ET(K24>0;L24>0);$B$24/$E$24)));SI(ET(K25>0;L25="");$B$25/$E$25/2;SI(ET(K25="";L25>0);$B$25/$E$25/2;SI(ET(K25>0;L25>0);$B$25/$E$25)));SI(ET(K26>0;L26="");$B$26/$E$26/2;SI(ET(K26="";L26>0);$B$26/$E$26/2;SI(ET(K26>0;L26>0);$B$26/$E$26)));SI(ET(K27>0;L27="");$B$27/$E$27/2;SI(ET(K27="";L27>0);$B$27/$E$27/2;SI(ET(K27>0;L27>0);$B$27/$E$27)));SI(ET(K28>0;L28="");$B$28/$E$28/2;SI(ET(K28="";L28>0);$B$28/$E$28/2;SI(ET(K28>0;L28>0);$B$28/$E$28)));SI(ET(K29>0;L29="");$B$29/$E$29/2;SI(ET(K29="";L29>0);$B$29/$E$29/2;SI(ET(K29>0;L29>0);$B$29/$E$29)));SI(ET(K30>0;L30="");$B$30/$E$30/2;SI(ET(K30="";L30>0);$B$30/$E$30/2;SI(ET(K30>0;L30>0);$B$30/$E$30)));SI(ET(K31>0;L31="");$B$31/$E$31/2;SI(ET(K31="";L31>0);$B$31/$E$31/2;SI(ET(K31>0;L31>0);$B$31/$E$31)));SI(ET(K32>0;L32="");$B$32/$E$32/2;SI(ET(K32="";L32>0);$B$32/$E$32/2;SI(ET(K32>0;L32>0);$B$32/$E$32)));SI(ET(K33>0;L33="");$B$33/$E$33/2;SI(ET(K33="";L33>0);$B$33/$E$33/2;SI(ET(K33>0;L33>0);$B$33/$E$33)));SI(ET(K34>0;L34="");$B$34/$E$34/2;SI(ET(K34="";L34>0);$B$34/$E$34/2;SI(ET(K34>0;L34>0);$B$34/$E$34)));SI(ET(K35>0;L35="");$B$35/$E$35/2;SI(ET(K35="";L35>0);$B$35/$E$35/2;SI(ET(K35>0;L35>0);$B$35/$E$35)));SI(ET(K36>0;L36="");$B$36/$E$36/2;SI(ET(K36="";L36>0);$B$36/$E$36/2;SI(ET(K36>0;L36>0);$B$36/$E$36)))))

alors quand tu parles d'usine à gaz .....