Case à cocher bis

Le 11/06/2015 à 12:35

Bonjour

J'ai une feuille excel qui va avoir une centaine de case à cocher. Elle seront 4 par ligne

J'ai déjà fais la programmation pour les 4 premières. Ensuite j'ai copier le texte VBA et est modifié pour les case 5 à 8.

Existe-t-il un moyen de faire autrement car cela prendra bcp de temps et le risque d'erreur est grand

D'avance un gramd merci pour vos précieux conseils.

Stéphane

13tableau.xlsm (282.30 Ko)
Le 11/06/2015 à 12:56

Bonjour

Evite les cases à cocher sur des feuilles qui sont des objets difficilement contrôlables.

Tu peux facilement :

- faire un code qui te mets une croix par exemple dans la cellule par double clique ou clique droit

ou

- utiliser une seule colonne reprenant une liste déroulante de choix "pas nécessaire, en ordre, ..."

ton avis ?

Crdlt

Le 11/06/2015 à 13:15

Bonjour Dan

Merci pour votre réponse,

Concernant la liste déroulante cela ne me permettra pas d'avoir un historique claire à mon sens.

Concernant la mise d'un code qui te mets une croix par exemple dans la cellule par double clique. je ne sais absolument pas le faire mais ça pourrait être une solution

Le 11/06/2015 à 13:28

Re,

Clique droite sur l'onglet Feuille 2 dans ton fichier et place ce code dans la fenêtre

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("B4:E" & Range("A" & Rows.Count).End(xlUp).Row)) Is Nothing Then
Range(Cells(Target.Row, 2), Cells(Target.Row, 5)).ClearContents
Cancel = True
Target = "X"
End If
End Sub

Tu peux après supprimer tous les codes de case à cocher --> CheckBox_Click

Donne ton avis si les possibilités que tu veux avoir. On améliorera le code

Crdlt

Edit Dan : code modifié

Le 11/06/2015 à 13:43

Re bonjour dan

Un grand merci pour le code, je vais essayer d'y intégrer le remplissage des colonnes des cellules C à E si B est sélectionner et l'enlever si c'est C qui est finalement sélectionner.

Je remarque que pour la colonne E le "X reste toujours même si je clique dans les autres colonnes (B, C ou D). Les 3 premières fonctionne

Merci

Le 11/06/2015 à 13:45

re

regarde le code, je l'ai modifié. Tu dois avoir 5 au lieu de 4 dans la 3ieme ligne

Crdlt

Le 11/06/2015 à 13:52

Super Merci

J'essaye de mettre ce code pour être identique au checkbox

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Not Intersect(Target, Range("B4:e" & Range("A" & Rows.Count).End(xlUp).Row)) Is Nothing Then

Range(Cells(Target.Row, 2), Cells(Target.Row, 4)).ClearContents

Cancel = True

Target = "X"

End If

If Range("b10") <> "" Then Range("c10:e10,g10:h10").Select

With Selection.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.Color = 16737792

.TintAndShade = 0

.PatternTintAndShade = 0

End With

Range("I10").Select

ActiveCell.FormulaR1C1 = "1"

Range("F10").Select

Else

Range("b10") = ""

Range("c10:e10,g10:h10").Select

With Selection.Interior

.Pattern = xlNone

.TintAndShade = 0

.PatternTintAndShade = 0

End With

Range("I10").Select

Selection.ClearContents

Range("F10").Select

End If

End Sub

1) il ne fonctionne pas

2) je devrais mettre un code pour chaque cellule

Y'a-t-il un autre moyen de le créer par ligne ?

Merci

Le 12/06/2015 à 08:09

re

essaie ceci :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("B4:E" & Range("A" & Rows.Count).End(xlUp).Row)) Is Nothing Then
    Range(Cells(Target.Row, 2), Cells(Target.Row, 4)).ClearContents
    Cancel = True
    Target = "X"

For i = 1 To 4
    If Cells(Target.Row, i + 1) <> "X" Then Cells(Target.Row, i + 1).Interior.Color = 16737792
Next

Target.Interior.Color = xlNone
Range("G" & Target.Row & ":H" & Target.Row).Interior.Color = 16737792
End If
End sub

A te relire

Le 12/06/2015 à 08:20

Bonjour Dan

Excellent, ça fonctionne à merveille merci beaucoup.

Si je peux encore abuser de vos connaissances, je souhaiterais apporter une modification car quand on coche les case D (en cours) et E (à corriger), je souhaiterais que les cases G (délai) et H(corrigé) ne soit pas rempli. Pour le reste c'est parfait.

Un très grand merci. Vous m'avez grandement faciliter la tâche.

Excellente journée

RE bonjour

Il faudrait encore intégrer que lorsque la colonne D est sélectionner il y ait ces Inputbox qui apparaissent

If CheckBox3 And [f9] = "" Then

resultat = InputBox("vous devez indiquer la/les raison(s) pour laquelle le dossier ne peut pas être visé", "Remarque(s)") '

If resultat <> "" Then [f9] = resultat

End If

If CheckBox3 And [g9] = "" Then

resultat = InputBox("vous devez indiquer un délai pour le suivi", "Délai") '

If resultat <> "" Then [g9] = resultat

End If

et quand la colonne E celles-ci

If CheckBox4 And [f9] = "" Then

resultat = InputBox("vous devez indiquer la/les corrections à effectuer", "Correction") '

If resultat <> "" Then [f9] = resultat

End If

If CheckBox4 And [g9] = "" Then

resultat = InputBox("vous devez indiquer un délai pour le suivi", "Délai") '

If resultat <> "" Then [g9] = resultat

End If

Voilà les formules mises pour les checkbox

D'avance un énorme merci

Le 12/06/2015 à 08:53

Cher Dan

Je vais me permettre d'abuser encore afin que le fichier touche à la perfection

Serait-il possible d'intégrer une code pour signaler que si j'efface le x (car je me suis trompé, toutes les cellules de la ligne redevienne sans remplissage ?

Merci merci

Le 12/06/2015 à 13:23

Re

Effacer par la touche clavier ? ou double clique ?

Crdlt

Le 12/06/2015 à 14:16

Re bonjour Dan

Par la touche clavier svp

Meilleures salutations

Le 12/06/2015 à 16:07

re

Sinon fais ceci

  • En entête, dans le fichier posté juste avant Private Sub Worksheet_Activate() mets cette instruction -->Dim as boolean
  • Ensuite colle ces deux codes :
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("B4:E" & Range("A" & Rows.Count).End(xlUp).Row)) Is Nothing Then
    stp = True
    Range(Cells(Target.Row, 2), Cells(Target.Row, 5)).ClearContents
    Cancel = True
    Target = "X"
    stp = False
Dim i As Byte
For i = 1 To 4
    If Cells(Target.Row, i + 1) <> "X" Then Cells(Target.Row, i + 1).Interior.Color = 16737792
Next

With Target
    .Interior.Color = xlAutomatic
    If .Column = 4 Or .Column = 5 Then
        Range("G" & .Row & ":H" & .Row).Interior.Color = xlNone
    Else: Range("G" & .Row & ":H" & .Row).Interior.Color = 16737792
    End If
End With

End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If stp = True Then Exit Sub
If Not Intersect(Target, Range("B4:E" & Range("A" & Rows.Count).End(xlUp).Row)) Is Nothing Then
    Range("B" & Target.Row & ":H" & Target.Row).Interior.Color = xlNone
End If
End Sub

A te relire

Le 12/06/2015 à 17:03

Bonjour Dan,

un tout grand merci, ça fonctionne très bien et c'est exactement ce que je veux. J'essaie de rajouter 2 inputbox si on sélectionne la colonne 4 ou 5 mais ça me met un bug End with sans with.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Not Intersect(Target, Range("B4:E" & Range("A" & Rows.Count).End(xlUp).Row)) Is Nothing Then

stp = True

Range(Cells(Target.Row, 2), Cells(Target.Row, 5)).ClearContents

Cancel = True

Target = "X"

stp = False

Dim i As Byte

For i = 1 To 4

If Cells(Target.Row, i + 1) <> "X" Then Cells(Target.Row, i + 1).Interior.Color = 16737792

Next

With Target

.Interior.Color = xlAutomatic

If .column = 4 then

resultat = InputBox("vous devez indiquer la/les raison(s) pour laquelle le dossier ne peut pas être visé", "Remarque(s)") '

If resultat <> "" Range("F" & .Row) = resultat

End If

If .column = 4 then

resultat = InputBox("vous devez indiquer un délai pour le suivi", "Délai") '

If resultat <> "" Range("G" & .Row) = resultat

End If

If .column = 5 then

resultat = InputBox("vous devez indiquer la/les corrections à effectuer", "Correction") '

If resultat <> "" Range("F" & .Row) = resultat

End If

if .column = 5 then

resultat = InputBox("vous devez indiquer un délai pour le suivi", "Délai") '

If resultat <> "" Range("G" & .Row) = resultat

End If

End With

end sub

Cela ne fonctionne malheureusement pas ? avez-vous une idée

Encore merci

Le 13/06/2015 à 14:08

re

effectivement tu as oublié des instructions. Essaie comme ceci :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim resultat
If Not Intersect(Target, Range("B4:E" & Range("A" & Rows.Count).End(xlUp).Row)) Is Nothing Then
 stp = True
 Range(Cells(Target.Row, 2), Cells(Target.Row, 5)).ClearContents
 Cancel = True
 Target = "X"
 stp = False
Dim i As Byte
For i = 1 To 4
 If Cells(Target.Row, i + 1) <> "X" Then Cells(Target.Row, i + 1).Interior.Color = 16737792
Next

With Target
 .Interior.Color = xlAutomatic

If .Column = 4 Then
resultat = InputBox("vous devez indiquer la/les raison(s) pour laquelle le dossier ne peut pas être visé", "Remarque(s)") '
If resultat <> "" Then Range("F" & .Row) = resultat
 End If
If .Column = 4 Then
 resultat = InputBox("vous devez indiquer un délai pour le suivi", "Délai") '
 If resultat <> "" Then Range("G" & .Row) = resultat
 End If

If .Column = 5 Then
 resultat = InputBox("vous devez indiquer la/les corrections à effectuer", "Correction") '
 If resultat <> "" Then Range("F" & .Row) = resultat
 End If

If .Column = 5 Then
 resultat = InputBox("vous devez indiquer un délai pour le suivi", "Délai") '
If resultat <> "" Then Range("G" & .Row) = resultat
 End If
End With
End If
End Sub

A te relire

Crdlt

Le 15/06/2015 à 07:43

Cher Dan

C'est parfait. c'est exactement ce que je voulais. Un tout grand merci pour votre précieuse aide.

Excellente journée

Le 15/06/2015 à 09:27

Re bonjour Dan

En utilisant le tableau j'aimerais encore le perfectionner de la manière suivante :

  • Si j'efface le X dans les colonne B à E cela efface le contenu dans les colonnes G & H
  • Si il y a un x dans les colonnes B ou C et qu'il y a qqch d'écrit dans les colonnes G&H, une msgbox apparait et demande si on doit effacer les croix ou le texte (2 boutons) en cliquant sur le bouton ça efface ce que l'on a demandé

D'avance un très grand merci.

Le 15/06/2015 à 12:47

RE

- Si j'efface le X dans les colonne B à E cela efface le contenu dans les colonnes G & H

Modifies le code que je t'ai donné plus tôt dans le fil

Private Sub Worksheet_Change(ByVal Target As Range)
If stp = True Then Exit Sub
If Not Intersect(Target, Range("B4:E" & Range("A" & Rows.Count).End(xlUp).Row)) Is Nothing Then
    Range("B" & Target.Row & ":H" & Target.Row).Interior.Color = xlNone
    Range("G" & Target.Row & ":H" & Target.Row).clearcontents
End If
End Sub

Je reviens pour le reste mais pour la deuxième question, cela peut se faire avec deux messages box. Ok ou pas ?

Crdlt

Le 15/06/2015 à 13:22

Oui bien sûr, le plus simplement

Merci

Ah merci

Pour enlever le X je mettais le même code, mais je laissais le "B" à la place du "G" et le système me faisait un bug, après réflexion je comprends pourquoi.

Le 15/06/2015 à 13:30

Re

Que je comprenne bien, tu as une croix et B et une donnée en G et H

Actuellement tu cliques sur C, cela efface le X en B pour mettre en C, là tu veux une boite à message pour demande la suppression du X en C et une boite à message pour supprimer G et H ?

Rechercher des sujets similaires à "case cocher bis"