Modifier code

[WITER]

Re bonjour à tous , voilla j'ai ce code


Private Sub CommandButton2_Click()
ActiveSheet.Unprotect
Selection.Interior.ColorIndex = 3
Selection.Copy Destination:=Selection.Offset(0, -1)
Selection.Interior.ColorIndex = 15
Selection.Select
ActiveCell.FormulaR1C1 = "0"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub


je voudrais y rajouter des conditions:
si le contenu de la cellule est égale à 0 la mettre en jaune
si le contenu de la cellule est égale à 6,5 la mettre en bleu
si le contenu de la cellule est égale à 7,0 la mettre en bleu
si le contenu de la cellule est égale à 8,5 la mettre en rouge

merci encore pour votre aide

 

[MJ13]

Re : Modifier code

Bonjour,
Voici la syntaxe (non testée)

if activecell.value=0 then activecell.font.color= codecouleur
...
Pour trouver le code de la couleur tu dois trouver le code de chaque couleur en enregistrant une macro en mettant chaque cellule de la couleur que tu veux.

 

[news]

Re : Modifier code

Bonjour,

aulieu d'utiliser une macro,
une MFC(mise en forme conditionnelle) ferait aussi,
ou on peut utiliser 3 conditions,

sous Menu/Format/Mise en Format conditionnelle/
la valeur de la cellule est égale à 0,
>> y mettre format couleur jaune,
cliquez sur ajouter ...,

bonne journée encore

 

[Staple1600]

Re : Modifier code

Bonjour



Un exemple

sub colorcellule()
Dim c As Range
Set c = ActiveCell
Select Case c.Value
Case 0
c.Interior.ColorIndex = 6
Case 6.5, 7
c.Interior.ColorIndex = 41
Case 8.5
c.Interior.ColorIndex = 3
End Select
End sub

 

[WITER]

Re : Modifier code

Merci, une fois de plus , votre aide ma été precieuse
tt fonctionne

 

[WITER]

Re : Modifier code

Finalement j'ai encore un petit probleme, je voudrais rajouter dans mon code une condition:
la macro de doit fonctionner que si je selectionne une cellule entre G9:G5000
si je selectionne une cellule F15 par exemple rien ne doit se passer

Voici le code

Private Sub CommandButton1_Click()

ActiveSheet.Unprotect
Selection.Interior.ColorIndex = 8
Selection.Copy Destination:=Selection.Offset(0, 1)
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

merci d avance

 

[Staple1600]

Re : Modifier code

Bonjour



Dans ce cas, mette le code dans la feuille


Private Sub Worksheet_Change()

si je selectionne une cellule entre G9:G5000
si je selectionne une cellule F15 par exemple rien ne doit se passer

If Target.Column = 7 then
'ta macro
End if
End sub

 

[Staple1600]

Re : Modifier code

Re


Pour etre plus précis

Dans ce cas, c'est à la saisie que le changement de couleur s'effectue
(Pas quand on clique sur le CommandButton)

edit: en mieux écrit

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 7 And Not IsEmpty(Target) Then
    With Target.Interior
        Select Case Target.Value
        Case 0
            .ColorIndex = 6
        Case 6.5, 7
            .ColorIndex = 41
        Case 8.5
            .ColorIndex = 3
        End Select
    End With
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range 'inutile
Set c = Target ' inutile 
If Target.Column = 7 And Not IsEmpty(Target) Then
Select Case c.Value 'remplacer c par Target
Case 0
c.Interior.ColorIndex = 6
Case 6.5, 7
c.Interior.ColorIndex = 41
Case 8.5
c.Interior.ColorIndex = 3
End Select
End If
End Sub

 

[WITER]

Re : Modifier code

Désolé aucun des 3 codes ne fonctionne

 

[Staple1600]

Re : Modifier code

Re


Il faut mettre le code dans la feuille (pas dans un module standard)

voir fichier exemple

 

[WITER]

Re : Modifier code

Oui effectivement ca fonctionne mais c'est pas ce que je recherche.
Je cherche une solution pour que quand je selectionne une ou plusieurs cellules et que je clic sur mon bouton, ce code:

Private Sub CommandButton1_Click()

ActiveSheet.Unprotect
Selection.Interior.ColorIndex = 8
Selection.Copy Destination:=Selection.Offset(0, 1)
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

ne fonctionne que quand j'ai selectionné une ou plusieurs cellules de la colonne G uniquement.

 

[Staple1600]

Re : Modifier code

Re


Et tu ne vois pas comment adapter le code avec celui de ma pièce jointe?

Comment par exemple ajouter ceci
...
If Selection.Column =7 Then
Selection.Interior.ColorIndex = 8
...

Voila mon adaptation (pendant que le roti cuit, j'ai le temps)

[COLOR="blue"]version 2[/COLOR]
With Selection
    If .Column = 7 And Not IsEmpty(Selection) Then
        .Interior.ColorIndex = 8
        .Copy Destination:=.Offset(0, 1)
    End If
End With


[COLOR="Blue"]version 1[/COLOR]
If Not IsEmpty(Selection) And Selection.Column = 7 Then
Selection.Interior.ColorIndex = 8
Selection.Copy Destination:=Selection.Offset(0, 1)
End If

à mettre dans ton code entre
ActiveSheet.Unprotect
et
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True'*

* tu peux aussi l'écrire comme cela
ActiveSheet.Protect True, True, True

 

[WITER]

Re : Modifier code

En faite je t ai pas donné la bonne macro, desolé je debut en code vba
la voici

Sub Travail()



Selection.Copy Destination:=Selection.Offset(0, -1)

Selection.Select
ActiveCell.FormulaR1C1 = "0"

End Sub

et quand j'ajoute ton code
If Selection.Column = 7 Then

ca ne change rien a l'execution du code quand je selectionne une cellule qu'i n'est pas dans la colonne G, la macro s'execute quand meme alors que je voudrais qu'il ne se passe rien si je suis pas dans la colonne G


merci pour ta patiente

 

[Staple1600]

Re : Modifier code

Re

Chez moi ca fonctionne

Je dine et ensuite je t'envoie un fichier exemple.


edit: diner terminé, fichier envoyé

 

[WITER]

Re : Modifier code

Effectivement ca fonctionne, merci pour ton aide