Changer caractéristiques cellules si vide dans sélection
Bonjour le forum,
Je me rapproche de vous pour essayer de simplifier mon code sur une partie qui me prend beaucoup de lignes.
J'ai un formulaire avec une trentaine de cellules à compléter et un bouton valider.
Dans le bouton valider, j'ai ajouté :
If [B9] = "" Then
[B9].Borders.Color = 255
[B9].Borders.Weight = 4
Else:
[B9].Borders.Color = 1
[B9].Borders.Weight = 1
End if
If [B10] = "" Then
[B10].Borders.Color = 255
[B10].Borders.Weight = 4
Else:
[B10].Borders.Color = 1
[B10].Borders.Weight = 1
End ifetc... pour chaque cellule.
Est-ce qu'il existe une fonction qui détecte une ou plusieurs cellules vides dans la sélection pour modifier les caractéristiques de la cellule en question ?
Merci d'avance :)
Matthieu
Bonjour,
Est-ce que tu peux poster la partie en question du code en entier ?
Cdlt,
Bonjour 3GB et merci de ton implication :)
Il me faudra adapter mon code, puisque selon les Case ça ne sera pas les mêmes cellules à modifier mais voilà une partie du code avec seulement les parties de modifications de cellules :
Cellulesite = [E1]
Select Case Cellulesite
Case "Sinnamary"
' Encadre en rouge les cellules à compléter
If [B9] = "" Then
[B9].Borders.Color = 255
[B9].Borders.Weight = 4
Else:
[B9].Borders.Color = 1
[B9].Borders.Weight = 1
End If
If [B10] = "" Then
[B10].Borders.Color = 255
[B10].Borders.Weight = 4
Else:
[B10].Borders.Color = 1
[B10].Borders.Weight = 1
End If
If [B11] = "" Then
[B11].Borders.Color = 255
[B11].Borders.Weight = 4
Else:
[B11].Borders.Color = 1
[B11].Borders.Weight = 1
End If
If [B15] = "" Then
[B15].Borders.Color = 255
[B15].Borders.Weight = 4
Else:
[B15].Borders.Color = 1
[B15].Borders.Weight = 1
End If
If [B16] = "" Then
[B16].Borders.Color = 255
[B16].Borders.Weight = 4
Else:
[B16].Borders.Color = 1
[B16].Borders.Weight = 1
End If
If [F9] = "" Then
[F9].Borders.Color = 255
[F9].Borders.Weight = 4
Else:
[F9].Borders.Color = 1
[F9].Borders.Weight = 1
End If
If [F10] = "" Then
[F10].Borders.Color = 255
[F10].Borders.Weight = 4
Else:
[F10].Borders.Color = 1
[F10].Borders.Weight = 1
End If
If [F11] = "" Then
[F11].Borders.Color = 255
[F11].Borders.Weight = 4
Else:
[F11].Borders.Color = 1
[F11].Borders.Weight = 1
End If
If [F15] = "" Then
[F15].Borders.Color = 255
[F15].Borders.Weight = 4
Else:
[F15].Borders.Color = 1
[F15].Borders.Weight = 1
End If
If [F16] = "" Then
[F16].Borders.Color = 255
[F16].Borders.Weight = 4
Else:
[F16].Borders.Color = 1
[F16].Borders.Weight = 1
End If
Case "Agami"
' Encadre en rouge les cellules à compléter
If [D9] = "" Then
[D9].Borders.Color = 255
[D9].Borders.Weight = 4
Else:
[D9].Borders.Color = 1
[D9].Borders.Weight = 1
End If
If [D10] = "" Then
[D10].Borders.Color = 255
[D10].Borders.Weight = 4
Else:
[D10].Borders.Color = 1
[D10].Borders.Weight = 1
End If
If [D11] = "" Then
[D11].Borders.Color = 255
[D11].Borders.Weight = 4
Else:
[D11].Borders.Color = 1
[D11].Borders.Weight = 1
End If
If [D15] = "" Then
[D15].Borders.Color = 255
[D15].Borders.Weight = 4
Else:
[D15].Borders.Color = 1
[D15].Borders.Weight = 1
End If
If [D16] = "" Then
[D16].Borders.Color = 255
[D16].Borders.Weight = 4
Else:
[D16].Borders.Color = 1
[D16].Borders.Weight = 1
End If
If [F9] = "" Then
[F9].Borders.Color = 255
[F9].Borders.Weight = 4
Else:
[F9].Borders.Color = 1
[F9].Borders.Weight = 1
End If
If [F10] = "" Then
[F10].Borders.Color = 255
[F10].Borders.Weight = 4
Else:
[F10].Borders.Color = 1
[F10].Borders.Weight = 1
End If
If [F11] = "" Then
[F11].Borders.Color = 255
[F11].Borders.Weight = 4
Else:
[F11].Borders.Color = 1
[F11].Borders.Weight = 1
End If
If [F15] = "" Then
[F15].Borders.Color = 255
[F15].Borders.Weight = 4
Else:
[F15].Borders.Color = 1
[F15].Borders.Weight = 1
End If
If [F16] = "" Then
[F16].Borders.Color = 255
[F16].Borders.Weight = 4
Else:
[F16].Borders.Color = 1
[F16].Borders.Weight = 1
End If
End selectJ'aurai également un bricolage a faire avec les cases à cocher qui se trouvent sur une cellule, probablement quelque chose comme ça, je ne sais pas si c'est simplifiable
If CheckBox1.Value = False Then
[B8].Borders.Color = 255
[B8].Borders.Weight = 4
Else:
[B8].Borders.Color = 1
[B8].Borders.Weight = 1
End If
If CheckBox2.Value = False Then
[B12].Borders.Color = 255
[B12].Borders.Weight = 4
Else:
[B12].Borders.Color = 1
[B12].Borders.Weight = 1
End If
If CheckBox3.Value = False Then
[B13].Borders.Color = 255
[B13].Borders.Weight = 4
Else:
[B13].Borders.Color = 1
[B13].Borders.Weight = 1
End IfJe n'ai pas mit non plus tous les Case car il y en a 7 en tout, c'est un peu long a rédiger justement ^^'
Merci :)
Matthieu
Re,
Voici un premier essai où il faudra compléter ce que je n'ai pas fait, notamment les 5 cas manquants :
tcase = array("Sinnamary", "agami", ...) '<<< rajouter 5 autres cas
tsinna = array("B9", "B10", "B11", "B15", "B16", "F9", "F10", "F11", "F15", "F16")
tagam = array("D9", "D10", ....) '<<< compléter et faire de même pour les 5 autres cas
tref = array(tsinna, tagam, ...) 'compléter avec les 5 autres tableaux à créer
for i = lbound(tcase) to ubound(tcase)
if range("E1") = tcase(i) then
for each elem in tref(i)
with range(elem)
If .value = "" Then
.Borders.Color = 255: .Borders.Weight = 4
Else:
.Borders.Color = 1
.Borders.Weight = 1
End If
end with
next elem
end if
next iCdlt,
Je vais essayer de l'adapter à mes CheckBox, le tcase devrait être le même, t(lieux) avec les checkbox et au lieux de les encadrer à la rigueur je vais colorier les CheckBox directement.
J'essaye de faire ça, dans tous les cas je reviens vers toi si j'ai réussi ou pas :)
Hello,
3GB si tu es toujours par là, j'ai essayé d'adapter ton code à mes CheckBox sans succès.
Dim ctrl As Control
tcase = Array("Sinnamary", "Agami", "Toucan") ', "Centre technique", "Météo Isabelle", "Hôtel des roches", "Embarcadère des îles") 'Selon le Case
tsinna = Array("CheckBox1", "CheckBox2", "CheckBox3""CheckBox4", "CheckBox5", "CheckBox6", _
"CheckBox7", "CheckBox8", "CheckBox9", "CheckBox10", "CheckBox11", "CheckBox12", "CheckBox13", _
"CheckBox14", "CheckBox15", "CheckBox16", "CheckBox17") ' quoi checker
tagami = Array("CheckBox6", "CheckBox7", "CheckBox8", "CheckBox9", "CheckBox10", _
"CheckBox11", "CheckBox12", "CheckBox13", "CheckBox14", "CheckBox15", "CheckBox16", "CheckBox17")
tref = Array(tsinna, tagami) ' ,ttoucan, tct, tmeteo, thdr, tedi) 'Selectionne le bon Case
For i = LBound(tcase) To UBound(tcase) '
If Range("E1") = tcase(i) Then ' Cherche quel Case
For Each elem In tref(i) ' chaque chkbox dans tlieu
With ctrl(elem) '
If .Value = False Then
.BackColor = H000000FF 'Rouge
Else:
.BackColor = H80000005 'Blanc
End If
End With
Next elem
End If
Next iJ'ai essayé plusieurs méthodes celle-ci est celle qui s'approche au mieux puisque la ligne "With ctrl(elem)" arrive à sélectionner "CheckBox1" mais une erreur apparait :
Erreur 91 : Variable objet ou variable de blox with non définie... J'ai essayé de déclarer en tant que ChekBox c'est pas bon non plus.
Peut-être qu'il ne faut pas passer par un Array pour les CheckBox
Si tu as un peu de temps encore à me consacrer je t'en serai reconnaissant :D
Merci d'avance,
Matthieu
Hello,
Je suis passé avec un tout autre outil sans succès toujours mais voilà l'idée :
For Each ccase In ActiveSheet.OLEObjects
If ccase.Object.Value = False Then
ccase.Object.BackColor = H000000FF 'Rouge
Else:
ccase.Object.BackColor = H80000005 'Blanc
End If
Next ccaseLe soucis pour le moment c'est que toutes les CheckBox deviennent noires (pas rouge) et que même les boutons sont affectés.
J'ai essayé de retirer la boucle For; déclarer ccase as CheckBox pas bon non plus.
Je continue mes recherches.
Voici un essai pour le second problème :
dim ctrl as oleobject
For Each ctrl In ActiveSheet.OLEObjects
with ctrl
if typename(.object) = "CheckBox" then
If .object.Value = False Then
.object.BackColor = RGB(255, 0, 0) 'Rouge
Else:
.object.BackColor = RGB(255, 255, 255) 'Blanc
End If
end if
end with
Next ctrlLe problème est qu'il s'agit de contrôles sur feuilles.
Je n'y suis pas vraiment habitué et n'ai pas testé donc c'est à voir mais l'idée que tu as eue me semble bien. Il faut bien exécuter le code au pas à pas détaillé (touche F8) pour voir le comportement lors de l'exécution (si les conditions sont bien remplies ou pas notamment).
De mémoire, il faut effectivement peut-être rajouter ctrl.object pour accéder aux propriétés de la checkbox... Pour l'instant, je ne peux pas tester donc je verrai plus tard.
Sinon, il est probablement possible de passer par un module de classe et de gérer ça grâce à un évènement (actualiser la mise en forme des contrôles à chaque clic par exemple).
Sinon, pour le code précédent, il aurait plutôt fallu avoir with controls(elem) ou dans ton cas with oleobjects(elem)
NB : Pour ce code, il faut autant d'éléments dans le tableau tref que dans tcase pour éviter une erreur 9.
Edit : Code édité !
Salut MatthieuGIL,
Voici ci-dessous l'idée dont je te parlais hier, si elle t'intéresse. L'idée est de créer une classe afin de personnaliser l'évènement click des checkbox. De cette manière, le comportement lors d'un click est identique pour chacune des checkbox (en fait pour chacun des oleobject dont de type checkbox). Ca permet de factoriser le code.
'-----CODE A PLACER DANS UN MODULE DE CLASSE A RENOMMER "OleCheckBox"
Public WithEvents CKB As MSFORMS.CheckBox
Private Sub CKB_Click()
Application.ScreenUpdating = False
With CKB
If .Value = False Then
.BackColor = RGB(255, 0, 0) 'Rouge
Else:
.BackColor = RGB(0, 255, 0) 'Vert
End If
End With
Application.ScreenUpdating = True
End Sub
'-----CODE A PLACER DANS LE MODULE DE LA FEUILLE CONTENANT LES CHECKBOX
Private Sub Worksheet_Activate()
Olechkbox_GetEvents Me
End Sub
Private Sub Worksheet_Deactivate()
Erase chkX
End Sub
'CODE A PLACER DANS UN MODULE STANDARD
Public chkX() As New OleCheckBox
Sub Olechkbox_GetEvents(Feuille As Worksheet)
Dim ctrl As OLEObject
For Each ctrl In Feuille.OLEObjects
If TypeName(ctrl.Object) = "CheckBox" Then
n = n + 1
ReDim Preserve chkX(1 To n)
Set chkX(n).CKB = ctrl.Object
End If
Next ctrl
End SubCdlt,
Bonjour,
Je viens tout juste de réussir à finaliser également une manière qui fonctionne avec les objets :
Dim ws As Worksheet
Dim oj As OLEObject
Set ws = ActiveSheet
For Each oj In ws.OLEObjects
If TypeName(oj.Object) = "CheckBox" Then
If oj.Object.Value = False Then
oj.Object.BackColor = &HFF&
Else:
oj.Object.BackColor = &H80000005
End If
End If
Next ojCe que tu avais proposé était pratiquement bon (j'ai appris que les CheckBox en object ne voulaient pas du RGB en couleur, à chaque fois j'avais un défaut)
Dans le typename(**) il manquait le .Object je pense, j'ai fouillé sur internet par finir par trouver un code basique de "valider checkbox" que j'ai fait évoluer pour finir pratiquement comme le tien.
Etant donné que j'enregistre le fichier sous un autre nom lors de la 1ère validation, je devrais importer le module (je le fait déjà avec un UserForm), je vais du coup garder le code si dessus.
Merci beaucoup pour ton aide !
Tu gères vraiment dans Excel c'est beau à voir ;)
A bientôt peut être,
Matthieu
Je t'en prie et, désolé, c'était un code approximatif et j'ai oublié de corriger le RGB dans le code précédent...
En tout cas, je suis content que ça marche comme tu le souhaites !
A bientôt sur un fil,
Bonne continuation,