macro pour création case à cocher

[letroubadour]

bonjour à tous

je cherche à créer une macro pour afficher une case à cocher en fonction d'un critère
dans l'onglet "01" si AG =1, alors création de la case à cocher sous "soir" dans la colonne M, la cellule liée est en AE et suppression de la case à cocher lors de l'appui du bouton "effacer"
cette macro doit se réaliser sur les 12 onglet, "01, 02, ........., 12"

merci

RAPHAEL

 

[chris]

Bonjour

Insérer une multitude de cases à cocher et autre boutons d'options, alourdit beaucoup un classeur tant en poids des objets (il y en aura plus de 2500 rien que pour les 12 mois) qu'en code associé.

De plus il semble y avoir un problème de gestion de la notion d'alternative liée aux boutons d'options.

Pourquoi ne pas plutôt gérer une coche ou autre directement dans la cellule ce qui peut être fait de façon plus simple au niveau du code et éviter ces milliers d'objets...

Ton approche m'a l'air inutilement compliquée.

 

[vgendron]

Hello
D'accord avec Chris, on peut se passer des cases à cocher..
les windings sont souvent oubliés :-D

voir code ci dessous

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("AG:AG")) Is Nothing And Target = 1 Then
    With Target.Offset(0, -2).Font
        .Name = "Wingdings"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With Target.Offset(0, -2)
        .FormulaR1C1 = "o"
    End With
End If

Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("AE:AE")) Is Nothing And Target <> "" Then
    Target = IIf(Target = "x", "o", "x")
    Target.Offset(0, -1).Select
End If
Application.EnableEvents = True
End Sub

 

[Staple1600]

Bonjour le fil

[Pour infos]
Sauf erreur de ma part, avec ce code ainsi raccourci, l'effet produit est le même, non ?

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("AG:AG")) Is Nothing And Target = 1 Then
    With Target.Offset(0, -2)
    .Font.Name = "Wingdings": .Font.Size = 10
    .Value = "o"
    End With
End If
Application.EnableEvents = True
End Sub

 

[letroubadour]

bonjour

merci pour vos réponses
il me faut une case à cocher pour sélectionner le repas du soir ou non

pour essayer cette macro dois-je créer un nouveau module ?

merci

 

[vgendron]

le code est à placer dans la feuille et pas dans un module

 

[chris]

Re à tous

Pourquoi ne pas mettre la colonne M en Wingdings taille 12 puis ceci dans le module du classeur

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Len(Sh.Name) > 2 Then Exit Sub
    If Intersect(Target, Sh.Range("E:E")) Is Nothing Or Target.Count > 1 Then Exit Sub
    Application.EnableEvents = False
    Target.Offset(0, 8).Value = IIf(Range("AG" & Target.Row) = 1, "ü", "")
  
    Application.EnableEvents = True

End Sub

Mais l'histoire de la case à cocher reste ambiguë : faut-il une case non cochée conditionnelle, qu'on coche ensuite ou non dans un second temps ?

Par ailleurs la liste déroulante en colonne E devrait utiliser une source correcte qui éviterait les lignes vides et la duplication inutile dans 12 onglets...

=DECALER('Distancier 1'!$B$9;;;NBVAL('Distancier 1'!$B$9:$B$158);1)

ou mieux une référence à une colonne de tableau structuré.

D'après tes précédents fils letroubadour, tu as 2010 alors pourquoi te priver de toutes les avancées d'Excel depuis 12 ans et utiliser un format périmé depuis ces 12 ans ?

 

[vgendron]

Voir en PJ

Note: 2Mo pour un fichier qui ne contient finalement pas grand chose de très compliqué, ca me semble déjà important...
ca rejoint donc à nouveau la remarque de Chris

je me suis permis de jeter un oeil sur tes macros et des les raccourcir pour certaines,
j'y ai mis un peu d'ordre

pour tes feuilles "Mois"
la colonne des jours fait sans cesse appel au calendrier..
on peut faire plus simple
1) nommer une cellue "AnnéeEnCours" pour savoir en quelle année on travaille==> c'est la cellule Q19 de ta feuille "Coordonnées de l'agent"
==> j'aurais trouvé plus pertinent de définir l'année sur ta page "Menu"
2) sur chaque feuille de Mois, mettre le numéro du mois (1 à 12) dans la cellule C6 ==> je l'ai colorée de telle manière qu'elle n'apparaisse pas à l'écran
3) et sur la colone C: mettre une formule

Colonne E: tu as une liste de validation qui fait appel à la colonne A de chaque mois
et à chaque fois, la colonne A, fait appel au Distancier1
autant créer une plage nommée qui contient les villes (et uniquement les villes sans vide inutiles)
puis tu fais appel à cette plage nommée dans tes listes de validation (Voir gestionnaire de noms pour la définition)
==> tu as une liste plus courte donc plus facile à sélectionner
==> plus besoin de la colonne A de chaque feuille
==> si tu ajoutes une ville dans le Distancier1, elle sera automatiquement ajoutée dans la plage nommée

j'ai modifié le code pour les cases à cocher : voir code de la feuille "01"

 

[letroubadour]

bonjour

merci pour tout

la case à cocher doit être en AG sous "soir" je ne sais pas si c'est possible car il y a déjà une case d'option et le résultat de vrai ou faux doit être en AE

merci

 

[vgendron]

euh.. as tu testé le fichier proposé?

et de ce que je vois.. sous "SOIR", c'est la colonne AE
en colonne AG, tu as une formule (dont le calcul déclenche la macro)
regarde les commentaires dans le code, tu devrais pouvoir adapter au besoin

 

[letroubadour]

dans mon premier post je veux que la case à cocher soit sous "soir" dans la colonne M et que en AE j'ai vrai ou faux si c'est coché ou non coché.
Oui c'est bien AG qui déclenche la macro.

si on appuie sur le bouton effacer la case doit être supprimée

 

[vgendron]

donc modification du code comme suit

Private Sub Worksheet_Calculate() 'à chaque fois que la feuille est recalculée, les Cases à cocher sont Mise à jour
Application.ScreenUpdating = False
Application.EnableEvents = False

Call PutCaseACocher(ActiveSheet.Name, "G") 'met une case en G si E contient une ville
Call PutCaseACocher(ActiveSheet.Name, "M") 'met une case en AE si AG=1

Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub




Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'si on clique sur une case en AG ou G, on bascule entre cochée et décochée
Application.EnableEvents = False
If Target.Count = 1 Then
    If ((Not Intersect(Target, Range("M:M")) Is Nothing) Or (Not Intersect(Target, Range("G:G")) Is Nothing)) And Target <> "" Then
        Target = IIf(Target = "x", "o", "x")
        Target.Offset(0, -1).Select
    End If
End If
Application.EnableEvents = True
End Sub

et

Sub PutCaseACocher(ws As String, QuelleCol As String)
Application.EnableEvents = False
With Sheets(ws)
    With .Range(QuelleCol & 9).Resize(30) 'on formate la colonne qui aura les cases en format "Wingdings"
        .Font.Name = "Wingdings"
    End With
    
    If QuelleCol = "M" Then
        For i = 9 To 39
            If .Range("AG" & i) = 1 Then 'on teste le contenu de la colonne AG
                .Range(QuelleCol & i).FormulaR1C1 = "o"
            Else
                .Range(QuelleCol & i) = ""
            End If
        Next i
    End If
    
    If QuelleCol = "G" Then
        For i = 9 To 39
            If .Range("E" & i) <> "" Then 'on teste le contenue de la colonne E
                .Range(QuelleCol & i).FormulaR1C1 = "o"
            Else
                .Range(QuelleCol & i) = ""
            End If
        Next i
    End If
End With
Application.EnableEvents = True
End Sub

 

[chris]

RE

Sauf que AG est une formule dépendant de E : c'est donc E le déclencheur comme je l'ai fait dans le code posté !

Edit : oups Vgendron, on a posté en même temps

 

[vgendron]

Hello Chris

De ce que je comprend
si il y a une selection en E ==> on met une case à cocher en G
si il y a une selection en E ==> la formule en AG met 1 ou rien
et c'est seulement si il y a 1 en AG qu'on met une case à cocher en M (sous Soir)

 

[letroubadour]

E n'a rien a voir , on peux très bien avoir quelque chose en E mais rien en AG
le déclencheur c'est AG=1
si la case est cochée alors AE =vrai
si non cochée alors AE=faux

et la case en G ne doit plus être présente