Reproduire la couleur d'une cellule, suivant un chiffre

Bonjour

Reproduire la couleur d’une cellule, suivant un chiffre (palette Excel) d’une autre cellule

Est-ce possible ?

Cordialement

Bonjour,

à tester,

Sub Test_Color()
ColorNumber = Range("O48")
Set plgRecherche = Range("E23:K36")
iColor = plgRecherche.Find(What:=ColorNumber, After:=plgRecherche(1), LookAt:=xlWhole).Interior.Color
Range("B48:J48").Interior.Color = iColor
End Sub

Bonsoir,

Je crois que je t’ai mis sur une fausse piste

Seules sont concernées les cellules O48 (pour inscrire le chiffre de la couleur de la palette) et les cellules fusionnées B48 :J48

La palette de couleur (E23 :K36) ne sert à rien, c’est juste un repère

Exemple J’inscris 46 en O48, les cellules B48 :J48 se colorient, je modifie le chiffre, la cellule change de couleur

Ton exemple ne semble pas fonctionner, mais je suis nul en informatique, alors je n’ai peut-être pas compris.

Merci de ta participation

Je crois que je t’ai mis sur une fausse piste

Seules sont concernées les cellules O48 (pour inscrire le chiffre de la couleur de la palette) et les cellules fusionnées B48 :J48

La palette de couleur (E23 :K36) ne sert à rien, c’est juste un repère

Exemple J’inscris 46 en O48, les cellules B48 :J48 se colorient, je modifie le chiffre, la cellule change de couleur

ok, alors copier cette macro sur la page code concernée,

Private Sub Worksheet_Change(ByVal Target As Range)
Set isect = Application.Intersect(Target, Range("O48"))
If isect Is Nothing Then Exit Sub
Range("B48:J48").Interior.ColorIndex = Target.Value
End Sub

Bonjour SabV

Désolé cela ne marche pas

Cordialement,

Bonjour toutes et tous et bon dimanche

@Bobbyfrance, ton classeur fichier doit être au format portant l'extension .xlsm et non. xlsx

il fonctionne le code de Sabv merci à lui (testé sur version d'Excel 2007 Fr)

ci-joint

crdlt,

André

Comme ceci ?

Bonjour,

Bravo à tous

Mille excuses à SavB

Cela marche super,

Les gros soucis arrivent

Comment faire pour l’incorporer dans le FICHIER ORIGINEL

Fichier très lourd avec de multiples macros

Et, informatiquement, je suis une « buse »

Je comprends vite……… mais il faut m’expliquer longtemps

Alors !!!

Ce serait dommage de ne pas y arriver, c’est vraiment le top

MERCI, c’est vraiment super

Bon dimanche

Re

J’ai oublié de préciser

Le fichier s’appelle « Récap Asso » je pense, pas très important

Par contre l’onglet concerné, c’est « Formulaire »

Bon dimanche

Bonjour Bobbyfrance,

Je te propose ce fichier Excel :

Alt F11 pour voir le code VBA, puis revenir sur Excel

⚠ Le code VBA doit être placé dans le code de ta feuille de calcul nommée "Formulaire" :

Cordialement,

dhany

Bonsoir à tous

J’ai réussi avec vos conseils, mais cela me crée un souci avec une macro (pardon une usine à gaz)

Le message d’erreur,

Erreur de compilation

End With sans Whit

Cela fonctionne sans le rajout du code.

Bien sûr, j’ai sauvegardé le fichier de départ, donc je suis sauvé

Merci malgré tout, pour votre bonne volonté, à tous

Cordialement,

Fais gaffe si tu n'as pas collé le code au milieu d'un autre code ! Je n'ai vu aucune proposition avec un "End with" donc ça ne vient pas d'ici

Salut Javier76,

C’est très possible, car c’est un formulaire avec des cellules protégées, et lorsque j’inscris une date, en mode protégé, j’ai le message suivant

Erreur d’exécution « 1004 »

Erreur définie par l’application ou par l’objet

Si je déprotège cela, passe

Alors, comment faire en partant du principe que je suis nul ?

Je joins une image, ou j’ai fait mon copier-coller

Merci

Bonne soirée

Ben je ne vois pas trop le soucis, tu es bien dans la feuil et pas dans un module donc ça devrait marcher.

Recopi ce code dans la zone blanche que tu as screenshot

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$O$48" Then [B48:J48].Interior.ColorIndex = Target
End Sub

Après ce n'est pas une macro que tu lances dans le menu des macros (alt+f8). Celle ci se fait automatiquement quand tu change la valeur de la cellule O48.

Si tu as encore une erreur fais un screen de l'erreur avec le tableau excel a gauche et le mode VBA pour avoir une vue d'ensemble

Re,

Cela marche que si je déprotège l’onglet

Ci-joint l’image

Même message d’erreur

Cordialement,

@Bobbyfrance

Comme ta feuille "Formulaire" est protégée, je te propose une adaptation de mon code VBA précédent :

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address <> "$O$48" Then Exit Sub
  ActiveSheet.Unprotect
  [B48:J48].Interior.ColorIndex = Target
  ActiveSheet.Protect
End Sub

⚠ S'il y a un mot de passe, par exemple toto, tu dois l'indiquer (2×) :

ActiveSheet.Unprotect "toto" puis ActiveSheet.Protect "toto"

⚠ Avec ou sans mot de passe, sur la feuille "Formulaire", clic droit sur O48,

Format de cellule, onglet Protection : ☐ Verrouillée

dhany

Salut Dhany,

Magnifique cela marche

Juste encore un mini souci, sur ce maudit onglet, j’ai une liste déroulante semi-automatique

cela veut dire que la protection se fait en cochant la case « modifier les objets » pour que cela fonctionne.

Peut-on remplacer « ActiveSheet.Protect» par un équivalent prenant en compte : modifier les objets ?

Sans solution, je ferais avec, c’est en fin de saisi

Bonne nuit

je suis ravi que tu aies apprécié mon code VBA précédent ! mais pour ta nouvelle demande, je suis désolé, je ne peux pas t'aider car moi non plus, je ne connais pas bien toutes les possibilités de cette fenêtre. je te laisse donc voir la suite avec un autre intervenant ; bonne chance ! et bonne nuit à toi aussi. dhany

Bonjour à tous,

d'abord merci! André pour avoir testé mon code, j'apprécie beaucoup.

Bobbyfrance, voici un exemple pour la protection,

With ActiveSheet
'permet filtre et grouper lignes et colonnes
    .EnableAutoFilter = True
    .EnableOutlining = True

    'pour les options de protection que vous ne désirer pas autoriser: changer True pour False
    .Protect Password:="", _
        DrawingObjects:=True, _
        Contents:=True, _
        Scenarios:=True, _
        AllowFormattingCells:=True, _
        AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, _
        AllowInsertingColumns:=True, _
        AllowInsertingRows:=True, _
        AllowInsertingHyperlinks:=True, _
        AllowDeletingColumns:=True, _
        AllowDeletingRows:=True, _
        AllowSorting:=True, _
        AllowFiltering:=True, _
        AllowUsingPivotTables:=True, _
        UserInterfaceOnly:=True
 End With

Un départ urgent de mon domicile, et je vous abandonne.

Excellente nouvelle, tout est parfait, et je ne sais pas comment vous remercier.

Chacun a apporté son grain de sable, et j’ai pu faire un château.

Nous (nous c’est l’Asso et moi) vous remercions pour votre patience.

Le fichier très lourd que j’essaye d’améliorer pour faciliter le bénévolat aura encore besoin de vos lumières.

Alors je vous dis à bientôt

Merci