colorier une cellule via checbox

K

kikii

XLDnaute Occasionnel
bonjour

qui aurais une idée de la manip a faire
j'ai plusieurs ligne dans excel

je voudrais que via un userform je selectione un numéro de dossier ce qui représente forecéement une ligne précise et de ce userform via checkbox je colorie la cellule en bleu quelquun a une idée?

merci d'avance.
 
Trier par date Trier par votes
fhoest

fhoest

XLDnaute Accro
Re : colorier une cellule via checbox

Bonsoir, Kikii,fo_rum,
je pense que le problème vient de déclaration de la variable dim lig as long, est elle comme dans le fichier exemple au début de code ou alors elle est dans le private sub ...
si c'est le cas cela ne fonctionnera pas car en entrant dans le sub elle perdra sa valeur et sera égale à 0
A suivre...
 
Vote positif 0 Vote négatif
K

kikii

XLDnaute Occasionnel
Re : colorier une cellule via checbox

je tai mis tout ce que j'ai fais et regarde si tu peux maider car ça fais pareille

Option Explicit
Dim RgDossier As Range
Dim lig As Long




Private Sub CheckBox1_Click()
Dim table
Dim lig As Long
Dim c As Range

Set table = Range("A" & lig & ":S" & lig)

If CheckBox1.Value = True Then
Sheets("Feuil1").Range("I" & lig).Interior.Color = vbBlue
For Each c In table
If c = "" Then c.Interior.Color = vbBlue
Next

End If



End Sub


Private Sub CheckBox10_Click()
Dim table
Dim c As Range

Set table = Range("A" & lig & ":S" & lig)

If CheckBox10.Value = True Then
Sheets("1janvier").Range("O" & lig).Interior.Color = vbBlue
For Each c In table
If c = "" Then c.Interior.Color = vbBlue
Next

End If
End Sub

Private Sub CheckBox11_Click()
Dim table
Dim c As Range

Set table = Range("A" & lig & ":S" & lig)

If CheckBox11.Value = True Then
Sheets("1janvier").Range("P" & lig).Interior.Color = vbBlue
For Each c In table
If c = "" Then c.Interior.Color = vbBlue
Next

End If
End Sub

Private Sub CheckBox12_Click()
Dim table
Dim c As Range

Set table = Range("A" & lig & ":S" & lig)

If CheckBox12.Value = True Then
Sheets("1janvier").Range("Q" & lig).Interior.Color = vbBlue
For Each c In table
If c = "" Then c.Interior.Color = vbBlue
Next

End If
End Sub

Private Sub CheckBox13_Click()
Dim table
Dim c As Range

Set table = Range("A" & lig & ":S" & lig)

If CheckBox13.Value = True Then
Sheets("1janvier").Range("R" & lig).Interior.Color = vbBlue
For Each c In table
If c = "" Then c.Interior.Color = vbBlue
Next

End If
End Sub

Private Sub CheckBox14_Click()
Dim table
Dim c As Range

Set table = Range("A" & lig & ":S" & lig)

If CheckBox14.Value = True Then
Sheets("1janvier").Range("S" & lig).Interior.Color = vbBlue
For Each c In table
If c = "" Then c.Interior.Color = vbBlue
Next

End If
End Sub

Private Sub CheckBox15_Click()
Dim table
Dim c As Range

Set table = Range("A" & lig & ":S" & lig)

If CheckBox15.Value = True Then

For Each d In table
If d = "" Or " " Then c.Interior.Color = vbRed
Next

End If
End Sub

Private Sub CheckBox2_Click()
Dim table
Dim c As Range

Set table = Range("A" & lig & ":S" & lig)

If CheckBox2.Value = True Then
Sheets("1janvier").Range("F" & lig).Interior.Color = vbBlue
For Each c In table
If c = "" Then c.Interior.Color = vbBlue
Next

End If
End Sub

Private Sub CheckBox3_Click()
Dim table
Dim c As Range

Set table = Range("A" & lig & ":S" & lig)

If CheckBox3.Value = True Then
Sheets("1janvier").Range("G" & lig).Interior.Color = vbBlue
For Each c In table
If c = "" Then c.Interior.Color = vbBlue
Next

End If
End Sub

Private Sub CheckBox4_Click()
Dim table
Dim c As Range

Set table = Range("A" & lig & ":S" & lig)

If CheckBox4.Value = True Then
Sheets("1janvier").Range("H" & lig).Interior.Color = vbBlue
For Each c In table
If c = "" Then c.Interior.Color = vbBlue
Next

End If
End Sub

Private Sub CheckBox5_Click()
Dim table
Dim c As Range

Set table = Range("A" & lig & ":S" & lig)

If CheckBox5.Value = True Then
Sheets("1janvier").Range("J" & lig).Interior.Color = vbBlue
For Each c In table
If c = "" Then c.Interior.Color = vbBlue
Next

End If
End Sub

Private Sub CheckBox6_Click()
Dim table As Range

Dim c As Range

Set table = Range("A" & lig & ":S" & lig)

If CheckBox6.Value = True Then
Sheets("1janvier").Range("K" & lig).Interior.Color = vbBlue
For Each c In table
If c = "" Then c.Interior.Color = vbBlue
Next

End If
End Sub

Private Sub CheckBox7_Click()
Dim table
Dim c As Range

Set table = Range("A" & lig & ":S" & lig)

If CheckBox7.Value = True Then
Sheets("1janvier").Range("L" & lig).Interior.Color = vbBlue
For Each c In table
If c = "" Then c.Interior.Color = vbBlue
Next

End If
End Sub

Private Sub CheckBox8_Click()
Dim table
Dim c As Range

Set table = Range("A" & lig & ":S" & lig)

If CheckBox8.Value = True Then
Sheets("1janvier").Range("M" & lig).Interior.Color = vbBlue
For Each c In table
If c = "" Then c.Interior.Color = vbBlue
Next

End If
End Sub

Private Sub CheckBox9_Click()
Dim table
Dim c As Range

Set table = Range("A" & lig & ":S" & lig)

If CheckBox9.Value = True Then
Sheets("1janvier").Range("N" & lig).Interior.Color = vbBlue
For Each c In table
If c = "" Then c.Interior.Color = vbBlue
Next

End If
End Sub

Private Sub CommandButton1_Click()
Unload UserForm4
End Sub
Private Sub UserForm_Initialize()

Set RgDossier = Feuil1.Range("A7", Feuil1.Range("A65536").End(xlUp))
Frame4.Visible = False
Frame5.Visible = False
Frame6.Visible = False
Frame7.Visible = False
Frame8.Visible = False
Frame9.Visible = False
Frame10.Visible = False
Frame11.Visible = False
Frame12.Visible = False
Frame13.Visible = False
Frame14.Visible = False

End Sub


Private Sub CommandButton59_Click()

End Sub

Private Sub CommandButton85_Click()
If CheckBox1.Value = False Then Sheets("1janvier").Range("I" & lig).Interior.Color = vbWhite

Unload Me


End Sub

Private Sub CommandButton86_Click()

'ici declarer la Lig en public dans le haut du modules
'ceci permettra de transporter la variable au travers le projet sans réinitialiser cette dernière

Dim Cel As Range
Dim lig As Integer
Set Cel = RgDossier.Find(TextBox15)


If Cel.Cells(1, 9) <> "" Then Frame4.Visible = True Else Frame4.Visible = False
If Cel.Cells(1, 10) <> "" Then Frame5.Visible = True Else Frame5.Visible = False
If Cel.Cells(1, 11) <> "" Then Frame6.Visible = True Else Frame6.Visible = False
If Cel.Cells(1, 12) <> "" Then Frame7.Visible = True Else Frame7.Visible = False
If Cel.Cells(1, 13) <> "" Then Frame8.Visible = True Else Frame8.Visible = False
If Cel.Cells(1, 14) <> "" Then Frame9.Visible = True Else Frame9.Visible = False
If Cel.Cells(1, 15) <> "" Then Frame10.Visible = True Else Frame10.Visible = False
If Cel.Cells(1, 16) <> "" Then Frame11.Visible = True Else Frame11.Visible = False
If Cel.Cells(1, 17) <> "" Then Frame12.Visible = True Else Frame12.Visible = False
If Cel.Cells(1, 18) <> "" Then Frame13.Visible = True Else Frame13.Visible = False
If Cel.Cells(1, 19) <> "" Then Frame14.Visible = True Else Frame14.Visible = False




With Sheets("1janvier")
If TextBox15.Value = "" Then
Exit Sub
End If
lig = .Columns("A").Find(What:=TextBox15, LookIn:=xlValues).Row


Me.TextBox35 = .Cells(lig, "B")
Me.TextBox34 = .Cells(lig, "c")
Me.TextBox36 = .Cells(lig, "E")

End With
Exit Sub
Faute:
MsgBox "Ce numéro de dossier n'existe pas"



End Sub



Private Sub Frame4_Click()

End Sub
 
Vote positif 0 Vote négatif
fhoest

fhoest

XLDnaute Accro
Re : colorier une cellule via checbox

Bonjour,
ici dans le code il y a dim lig as integer alors qu'il est déclarer en haut du module:
Code: 
Private Sub CommandButton86_Click()

'ici declarer la Lig en public dans le haut du modules
'ceci permettra de transporter la variable au travers le projet sans réinitialiser cette dernière

Dim Cel As Range
Dim lig As Integer
  Set Cel = RgDossier.Find(TextBox15)
   
   
  If Cel.Cells(1, 9) <> "" Then Frame4.Visible = True Else Frame4.Visible = False
  If Cel.Cells(1, 10) <> "" Then Frame5.Visible = True Else Frame5.Visible = False
  If Cel.Cells(1, 11) <> "" Then Frame6.Visible = True Else Frame6.Visible = False
  If Cel.Cells(1, 12) <> "" Then Frame7.Visible = True Else Frame7.Visible = False
  If Cel.Cells(1, 13) <> "" Then Frame8.Visible = True Else Frame8.Visible = False
  If Cel.Cells(1, 14) <> "" Then Frame9.Visible = True Else Frame9.Visible = False
  If Cel.Cells(1, 15) <> "" Then Frame10.Visible = True Else Frame10.Visible = False
  If Cel.Cells(1, 16) <> "" Then Frame11.Visible = True Else Frame11.Visible = False
  If Cel.Cells(1, 17) <> "" Then Frame12.Visible = True Else Frame12.Visible = False
  If Cel.Cells(1, 18) <> "" Then Frame13.Visible = True Else Frame13.Visible = False
  If Cel.Cells(1, 19) <> "" Then Frame14.Visible = True Else Frame14.Visible = False




With Sheets("1janvier")
 If TextBox15.Value = "" Then
 Exit Sub
End If
     lig = .Columns("A").Find(What:=TextBox15, LookIn:=xlValues).Row
   

Me.TextBox35 = .Cells(lig, "B")
Me.TextBox34 = .Cells(lig, "c")
Me.TextBox36 = .Cells(lig, "E")

End With
Exit Sub
Faute:
MsgBox "Ce numéro de dossier n'existe pas"



End Sub

l'erreur est la je pense,supprime cette ligne.
Code: 
dim lig as integer
A+
 
Vote positif 0 Vote négatif
K

kikii

XLDnaute Occasionnel
Re : colorier une cellule via checbox

je repost ton fichier que j'ai peu modifier for um mais j'obtien pas la bonne couleur jai des erreurs

car jai essayer de faire un code pour que par dfaut toute les cellules vide soit en bleue de la meme couleur

et j'aimerais dire que si la cellule 4 et de la cellule 6 à 19 elle sont colorier alors il faut colorier en bleu le reste des cellule de la ligne
 

Pièces jointes

  • ListBoxOptions.xlsm
    23.5 KB · Affichages: 41
  • ListBoxOptions.xlsm
    23.5 KB · Affichages: 42
  • ListBoxOptions.xlsm
    23.5 KB · Affichages: 44
Vote positif 0 Vote négatif
fhoest

fhoest

XLDnaute Accro
Re : colorier une cellule via checbox

Bonjour

Pour commencer ton code modifier
Code: 
Private Sub CommandButton85_Click()
With Sheets("VBA")
 If ComboBox1.Value = "" Then
 Exit Sub
End If
     lig = .Columns("A").Find(What:=ComboBox1, LookIn:=xlValues).Row
Set table = Range("A" & lig & ":S" & lig)



Sheets("VBA").Range("I" & lig).Interior.Color = RGB(0, 255, 255)
For Each d In table
If d = "" Then d.Interior.Color = RGB(0, 255, 255)
Next




  With ListBox1
    For n = 0 To .ListCount - 1
     Cells(L, Val(.List(n, 1))).Interior.Color = IIf(.Selected(n) = True, RGB(0, 255, 255), xlNone)
    Next
  End With
  With ListBox2
    For n = 0 To .ListCount - 1
      Cells(L, Val(.List(n, 1))).Interior.Color = IIf(.Selected(n) = True, RGB(0, 255, 255), xlNone)
    Next
  End With
  Me.Hide
  End With
  
End Sub
et je ne comprend pas ta phrase:
et j'aimerais dire que si la cellule 4 et de la cellule 6 à 19 elle sont colorier alors il faut colorier en bleu le reste des cellule de la ligne
Cliquez pour agrandir...

Si c'est ça que tu veux a tester:
Code: 
Private Sub CommandButton85_Click()
With Sheets("VBA")
 If ComboBox1.Value = "" Then
 Exit Sub
End If
     lig = .Columns("A").Find(What:=ComboBox1, LookIn:=xlValues).Row
Set table = Sheets("VBA").Range("A" & lig & ":S" & lig)



Sheets("VBA").Range("I" & lig).Interior.Color = RGB(0, 255, 255)
For Each d In table
If d = "" Then d.Interior.Color = RGB(0, 255, 255)
Next
If Sheets("VBA").Cells(lig, 4).Interior.Color = RGB(0, 255, 255) And Sheets("VBA").Range("F" & lig & ":S" & lig).Interior.Color = RGB(0, 255, 255) Then
Sheets("VBA").Range("A" & lig & ":T" & lig).Interior.Color = RGB(0, 255, 255)
End If




  With ListBox1
    For n = 0 To .ListCount - 1
     Cells(L, Val(.List(n, 1))).Interior.Color = IIf(.Selected(n) = True, RGB(0, 255, 255), xlNone)
    Next
  End With
  With ListBox2
    For n = 0 To .ListCount - 1
      Cells(L, Val(.List(n, 1))).Interior.Color = IIf(.Selected(n) = True, RGB(0, 255, 255), xlNone)
    Next
  End With
  Me.Hide
  End With
  
End Sub

A+
 
Dernière édition:
Vote positif 0 Vote négatif
K

kikii

XLDnaute Occasionnel
Re : colorier une cellule via checbox

je te renvoie le fichier modifier car c'est tout a fait ça que je voulais sauf qu'ils faut que je fasse deux fois la manip donc deux fois valider pour que ça colore ma ligne entiere
et je te repost car sur la ligne 2 4 5 ça me crer des erreurs et pas sur les autres alors je comprends pas

merci a toi
 

Pièces jointes

  • ListBoxOptions.xlsm
    26.9 KB · Affichages: 39
  • ListBoxOptions.xlsm
    26.9 KB · Affichages: 37
  • ListBoxOptions.xlsm
    26.9 KB · Affichages: 40
Vote positif 0 Vote négatif
fhoest

fhoest

XLDnaute Accro
Re : colorier une cellule via checbox

Bonsoir ,
voici ton fichier en retour:
je ne suis pas certains que le résultat que tu souhaites est celui ci mais bon,pas mon fichier a la base donc pas simple.
A+
 

Pièces jointes

  • ListBoxOptions_Vfo_rum_modif_fhoest.xlsm
    29.8 KB · Affichages: 45
Vote positif 0 Vote négatif
fhoest

fhoest

XLDnaute Accro
Re : colorier une cellule via checbox

Bonjour,
Pour ne pas retourner deux fois il faut déplacer un morceaux de code:
voir ici:
Code: 
Private Sub CommandButton85_Click()
 With Sheets("VBA")
  If ComboBox1.Value = "" Then
  Exit Sub
 End If
      lig = .Columns("A").Find(What:=ComboBox1, LookIn:=xlValues).Row
 Set table = Sheets("VBA").Range("A" & lig & ":S" & lig)
 
Dim j As Byte
  
    For n = LBound(mes_colonnes1) To UBound(mes_colonnes1) 'n = 0 To .ListCount - 1
    If mes_colonnes1(n) = 0 Then GoTo ici
    j = j + 1
    Cells(lig, mes_colonnes1(n)).Interior.Color = IIf(ListBox1.Selected(j - 1) = True, RGB(0, 255, 255), xlNone)
ici:
     Next
   
   j = 0
  
     For n = LBound(mes_colonnes2) To UBound(mes_colonnes2)
    If mes_colonnes2(n) = 0 Then GoTo ici2
    j = j + 1
    Cells(lig, mes_colonnes2(n)).Interior.Color = IIf(ListBox2.Selected(j - 1) = True, RGB(0, 255, 255), xlNone)
ici2:
    Next
   Erase mes_colonnes1
   Erase mes_colonnes2
   For i = 1 To 2
Sheets("VBA").Range("I" & lig).Interior.Color = RGB(0, 255, 255)
 For Each d In table
 If d = "" Then d.Interior.Color = RGB(0, 255, 255)
 Next
 If Sheets("VBA").Cells(lig, 4).Interior.Color = RGB(0, 255, 255) And Sheets("VBA").Range("F" & lig & ":S" & lig).Interior.Color = RGB(0, 255, 255) Then
 Sheets("VBA").Range("A" & lig & ":T" & lig).Interior.Color = RGB(0, 255, 255)
 End If
 Next i
   
i = 0
   Me.Hide
   End With
   
End Sub
A+
 
Vote positif 0 Vote négatif

Discussions similaires

L
  • Question
XL 2019 Plusieurs graphes filtrés via un segment
Réponses
0
Affichages
128
link93
L
D
  • Résolu(e)
Microsoft 365 TRIER SUR FEUILLE PROTEGER
Réponses
8
Affichages
153
dd_76
D
Y
  • Résolu(e)
XL 2013 Colorier une cellule en fonction d'une valeur
Réponses
3
Affichages
265
Yvan1
Y
misteryann
  • Question
XL 2016 Incrémenter cellule via USF (RESOLU)
Réponses
7
Affichages
287
Jacky67
Jacky67
N
  • Question
XL 2021 numérotation CheckBox
5 6 7
Réponses
90
Affichages
2 K
nano33320
N
V
  • Question
XL 2019 Numéro d'ordre automatique
Réponses
1
Affichages
175
vilcoyotte90
V
Y
  • Résolu(e)
XL 2013 Récupérer le contenu d'un Tableau dans un autre classeur via Power Query et non toute la feuille...
Réponses
4
Affichages
199
Yvan1
Y
Q
  • Question
XL 2019 Probleme liste déroulante via vba
Réponses
3
Affichages
419
Quicksland
Q
chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Renseignement horizontal avec intersections via UserForm
Réponses
4
Affichages
163
chaelie2015
chaelie2015
C
  • Résolu(e)
XL 2021 Remplacer ThisWorkbook.Path par une cellule précise
Réponses
6
Affichages
217
cgpa
C

Membres actuellement en ligne

15 membres et 285 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 201
Messages
2 086 166
Membres
103 151
dernier inscrit
nassim