CheckBox

maval

maval

XLDnaute Barbatruc
Bonjour,

J'aimerais savoir si possible d'interdire l'ouverture d'un userform en cochant un checkBox ?

en sachant que l'Userform et ouvert par une shappe avec ce code

Code: 
'=======Parti de L'Userf==========


choix = Format(CStr([c2]), "00")
    ActiveSheet.Shapes("US-" & choix).Fill.ForeColor.SchemeColor = 4

    If ActiveSheet.CheckBox1.Value = True Then
        Pref = LTrim(Replace(ActiveSheet.Shapes("US-" & choix).TextFrame2.TextRange.Characters.Text, vbLf, ""))
        Pref = LTrim(Mid(Pref, 3))
        Sheets(Pref).Visible = True
        Sheets(Pref).Activate
    End If
    For Each sh In Sheets
        If sh.Name <> "Etats_Unis" And sh.Name <> "Bd" And sh.Name <> Pref Then '"Feuil3" And sh.Name <> Pref Then
            sh.Visible = False
        End If
    Next
    
    With Feuil2
        Set cel = .Columns(2).Find(Feuil1.Range("c2"), , , xlWhole)
        If Not cel Is Nothing Then lig = cel.Row
    End With
    
    With UserEtats_Unis
        .T2 = Feuil2.Cells(lig, 4): .T3 = Feuil2.Cells(lig, 3): .T4 = Feuil2.Cells(lig, 2): .T1 = Feuil2.Cells(lig, 2)
       For i = 5 To 11
            .Controls("T" & i) = Feuil2.Cells(lig, i)
        Next i
        .Show 0
       'Stop
       
       'Code pour avoir le rafraichissement des textbox
       With UserEtats_Unis
        .T2 = Feuil2.Cells(lig, 4): .T3 = Feuil2.Cells(lig, 3): .T4 = Feuil2.Cells(lig, 1): .T1 = Feuil2.Cells(lig, 2)
        For i = 5 To 17
            .Controls("T" & i) = Feuil2.Cells(lig, i)
        Next i
        .UserForm_Activate
        .Show 0
    End With

Je vous remercie d'avance.
 
Dernière édition:
Trier par date Trier par votes
Papou-net

Papou-net

XLDnaute Barbatruc
Re : CheckBox

Bonjour Max,

Difficile d'interpréter la lecture de cet extrait de code sans avoir la structure de ton classeur sous les yeux.

Pourquoi ne pas avoir joint une copie de ton fichier (sans données confidentielles of course)?

Tu gagnerais du temps tout en épargnant nos neurones.

Cordialement.
 
Vote positif 0 Vote négatif
maval

maval

XLDnaute Barbatruc
Re : CheckBox

Bonjour Papou net

Voici mon code en entier, fichier trop lourd sinon pas de probleme

Code: 
Sub Etats()

 [c2] = Right$(Mid(Application.Caller, InStr(Application.Caller, "-") + 1), 2)
  [c2] = Mid(Application.Caller, InStr(Application.Caller, "-") + 1)
  
' ôter toutes les couleurs
For n = 1 To ActiveSheet.Shapes.Count - 3
      ActiveSheet.Shapes(n).Fill.ForeColor.SchemeColor = 9 'Blanc

Next n




' ci-dessous on colorie tous les dépt concernés en bleu
Select Case [c2]

Case 1  '(Delaware)
         ActiveSheet.Shapes("US-1").Fill.ForeColor.SchemeColor = 4 ';;
Case 2  '(Pennsylvanie)
         ActiveSheet.Shapes("US-2").Fill.ForeColor.SchemeColor = 4 ';;;;;
Case 3  '(New Jersey)
         ActiveSheet.Shapes("US-3").Fill.ForeColor.SchemeColor = 4 ';;;;;;
Case 4  '(Géorgie)
         ActiveSheet.Shapes("US-4").Fill.ForeColor.SchemeColor = 4 ';;;;;;
Case 5  '(Connecticut)
         ActiveSheet.Shapes("US-5").Fill.ForeColor.SchemeColor = 4 ';;;;;
Case 6  '(Massachusetts)
         ActiveSheet.Shapes("US-6").Fill.ForeColor.SchemeColor = 4 ';;;;
Case 7  '(Maryland)
         ActiveSheet.Shapes("US-7").Fill.ForeColor.SchemeColor = 4 ';;;;;;
Case 8  '(Caroline du Sud)
         ActiveSheet.Shapes("US-8").Fill.ForeColor.SchemeColor = 4 ';;;;;;
Case 9  '(New Hampshire)
         ActiveSheet.Shapes("US-9").Fill.ForeColor.SchemeColor = 4 ';;;;;;
Case 10  '(Virginie)
         ActiveSheet.Shapes("US-10").Fill.ForeColor.SchemeColor = 4
Case 11  '(New York)
         ActiveSheet.Shapes("US-11").Fill.ForeColor.SchemeColor = 4
Case 12  '(Caroline du Nord)
         ActiveSheet.Shapes("US-12").Fill.ForeColor.SchemeColor = 4
Case 13  '(Rhode Island)
         ActiveSheet.Shapes("US-13").Fill.ForeColor.SchemeColor = 4
Case 14  '(Vermont)
         ActiveSheet.Shapes("US-14").Fill.ForeColor.SchemeColor = 4
Case 15  '(Kentucky)
         ActiveSheet.Shapes("US-15").Fill.ForeColor.SchemeColor = 4
Case 16  '(Tennessee)
         ActiveSheet.Shapes("US-16").Fill.ForeColor.SchemeColor = 4
Case 17  '(Ohio)
         ActiveSheet.Shapes("US-17").Fill.ForeColor.SchemeColor = 4
Case 18  '(Louisiane)
         ActiveSheet.Shapes("US-18").Fill.ForeColor.SchemeColor = 4
Case 19  '(Indiana)
         ActiveSheet.Shapes("US-19").Fill.ForeColor.SchemeColor = 4
Case 20  '(Mississippi)
         ActiveSheet.Shapes("US-20").Fill.ForeColor.SchemeColor = 4
Case 21  '(Illinois)
         ActiveSheet.Shapes("US-21").Fill.ForeColor.SchemeColor = 4
Case 22  '(Alabama)
         ActiveSheet.Shapes("US-22").Fill.ForeColor.SchemeColor = 4
Case 23  '(Maine)
         ActiveSheet.Shapes("US-23").Fill.ForeColor.SchemeColor = 4
Case 24  '(Missouri)
         ActiveSheet.Shapes("US-24").Fill.ForeColor.SchemeColor = 4
Case 25  '(Arkansas)
         ActiveSheet.Shapes("US-25").Fill.ForeColor.SchemeColor = 4
Case 26, 260  '(Michigan)
         ActiveSheet.Shapes("US-26").Fill.ForeColor.SchemeColor = 4
         ActiveSheet.Shapes("US-260").Fill.ForeColor.SchemeColor = 4
Case 27  '(Floride)
         ActiveSheet.Shapes("US-27").Fill.ForeColor.SchemeColor = 4
Case 28  '(Texas)
         ActiveSheet.Shapes("US-28").Fill.ForeColor.SchemeColor = 4
Case 29  '(Iowa)
         ActiveSheet.Shapes("US-29").Fill.ForeColor.SchemeColor = 4
Case 30  '(Wisconsin)
         ActiveSheet.Shapes("US-30").Fill.ForeColor.SchemeColor = 4
Case 31  '(Californie)
         ActiveSheet.Shapes("US-31").Fill.ForeColor.SchemeColor = 4
Case 32  '(Minnesota)
         ActiveSheet.Shapes("US-32").Fill.ForeColor.SchemeColor = 4
Case 33  '(Oregon)
         ActiveSheet.Shapes("US-33").Fill.ForeColor.SchemeColor = 4
Case 34  '(Kansas)
         ActiveSheet.Shapes("US-34").Fill.ForeColor.SchemeColor = 4
Case 35  '(Virginie-Occidentale)
         ActiveSheet.Shapes("US-35").Fill.ForeColor.SchemeColor = 4
Case 36  '(Nevada)
         ActiveSheet.Shapes("US-36").Fill.ForeColor.SchemeColor = 4
Case 37  '(Nebraska)
         ActiveSheet.Shapes("US-37").Fill.ForeColor.SchemeColor = 4
Case 38  '(Colorado)
         ActiveSheet.Shapes("US-38").Fill.ForeColor.SchemeColor = 4
Case 39  '(Dakota du Sud)
         ActiveSheet.Shapes("US-39").Fill.ForeColor.SchemeColor = 4
Case 40  '(Dakota du Nord)
         ActiveSheet.Shapes("US-40").Fill.ForeColor.SchemeColor = 4
Case 41  '(Montana)
         ActiveSheet.Shapes("US-41").Fill.ForeColor.SchemeColor = 4
Case 42  '(Washington)
         ActiveSheet.Shapes("US-42").Fill.ForeColor.SchemeColor = 4
Case 43  '(Idaho)
         ActiveSheet.Shapes("US-43").Fill.ForeColor.SchemeColor = 4
Case 44  '(Wyoming)
         ActiveSheet.Shapes("US-44").Fill.ForeColor.SchemeColor = 4
Case 45  '(Utah)
         ActiveSheet.Shapes("US-45").Fill.ForeColor.SchemeColor = 4
Case 46  '(Oklahoma)
         ActiveSheet.Shapes("US-46").Fill.ForeColor.SchemeColor = 4
Case 47  '(Nouveau-Mexique)
         ActiveSheet.Shapes("US-47").Fill.ForeColor.SchemeColor = 4
Case 48  '(Arizona)
         ActiveSheet.Shapes("US-48").Fill.ForeColor.SchemeColor = 4
Case 49  '(Alaska)
         ActiveSheet.Shapes("US-49").Fill.ForeColor.SchemeColor = 4
Case 50  '(Hawaï)
         ActiveSheet.Shapes("US-50").Fill.ForeColor.SchemeColor = 4
      
End Select

On Error Resume Next
' et on colorie le dépt cliqué en vert


'=======Parti de L'Userf==========


choix = Format(CStr([c2]), "00")
    ActiveSheet.Shapes("US-" & choix).Fill.ForeColor.SchemeColor = 4

    If ActiveSheet.CheckBox1.Value = True Then
        Pref = LTrim(Replace(ActiveSheet.Shapes("US-" & choix).TextFrame2.TextRange.Characters.Text, vbLf, ""))
        Pref = LTrim(Mid(Pref, 3))
        Sheets(Pref).Visible = True
        Sheets(Pref).Activate
    End If
    For Each sh In Sheets
        If sh.Name <> "Etats_Unis" And sh.Name <> "Bd" And sh.Name <> Pref Then '"Feuil3" And sh.Name <> Pref Then
            sh.Visible = False
        End If
    Next
    
    With Feuil2
        Set cel = .Columns(2).Find(Feuil1.Range("c2"), , , xlWhole)
        If Not cel Is Nothing Then lig = cel.Row
    End With
    
    With UserEtats_Unis
        .T2 = Feuil2.Cells(lig, 4): .T3 = Feuil2.Cells(lig, 3): .T4 = Feuil2.Cells(lig, 2): .T1 = Feuil2.Cells(lig, 2)
       For i = 5 To 11
            .Controls("T" & i) = Feuil2.Cells(lig, i)
        Next i
        .Show 0
       'Stop
       
       'Code pour avoir le rafraichissement des textbox
       With UserEtats_Unis
        .T2 = Feuil2.Cells(lig, 4): .T3 = Feuil2.Cells(lig, 3): .T4 = Feuil2.Cells(lig, 1): .T1 = Feuil2.Cells(lig, 2)
        For i = 5 To 17
            .Controls("T" & i) = Feuil2.Cells(lig, i)
        Next i
        .UserForm_Activate
        .Show 0
    End With


End With

End Sub

Sub init()
Dim sh As Shape
For Each sh In Feuil1.Shapes
  If InStr(sh.Name, "-") > 0 Then sh.OnAction = "Etats"
Next sh
End Sub

Sub Oter_Couleur()
Dim n As Integer
For n = 1 To ActiveSheet.Shapes.Count - 3
'ActiveSheet.Shapes(n).Fill.ForeColor.SchemeColor = 9
Next n
End Sub

Sub Liste()
    For ctl = 1 To ActiveSheet.Shapes.Count
        MsgBox ActiveSheet.Shapes(ctl).Name & " - n°" & ctl
        ActiveSheet.Shapes(ctl).Select
    Next
End Sub
 
Vote positif 0 Vote négatif
Papou-net

Papou-net

XLDnaute Barbatruc
Re : CheckBox

RE

Je ne suis pas plus avancé, mais je vais quand-même tenter de te répondre.

En supposant que, si CheckBox1 est décoché le formulaire ne doit pas être affiché, je te suggère de modifier le code comme ceci:

Code: 
'=======Parti de L'Userf==========


choix = Format(CStr([c2]), "00")
    ActiveSheet.Shapes("US-" & choix).Fill.ForeColor.SchemeColor = 4

    If ActiveSheet.CheckBox1.Value = False Then Exit Sub
        Pref = LTrim(Replace(ActiveSheet.Shapes("US-" & choix).TextFrame2.TextRange.Characters.Text, vbLf, ""))
        Pref = LTrim(Mid(Pref, 3))
        Sheets(Pref).Visible = True
        Sheets(Pref).Activate
    End If
    For Each sh In Sheets
        If sh.Name <> "Etats_Unis" And sh.Name <> "Bd" And  sh.Name <> Pref Then '"Feuil3" And sh.Name <> Pref Then
            sh.Visible = False
        End If
    Next
    
    With Feuil2
        Set cel = .Columns(2).Find(Feuil1.Range("c2"), , , xlWhole)
        If Not cel Is Nothing Then lig = cel.Row
    End With
    
    With UserEtats_Unis
        .T2 = Feuil2.Cells(lig, 4): .T3 = Feuil2.Cells(lig, 3): .T4 = Feuil2.Cells(lig, 2): .T1 = Feuil2.Cells(lig, 2)
       For i = 5 To 11
            .Controls("T" & i) = Feuil2.Cells(lig, i)
        Next i
        .Show 0
       'Stop
       
       'Code pour avoir le rafraichissement des textbox
       With UserEtats_Unis
        .T2 = Feuil2.Cells(lig, 4): .T3 = Feuil2.Cells(lig, 3): .T4 = Feuil2.Cells(lig, 1): .T1 = Feuil2.Cells(lig, 2)
        For i = 5 To 17
            .Controls("T" & i) = Feuil2.Cells(lig, i)
        Next i
        .UserForm_Activate
        .Show 0
    End With
Mais je doute que le problème soit aussi simple. Sinon, tu peux alléger la copie du fichier en supprimant tout ce qui n'a pas de rapport avec ta demande, ou bien en le "zippant". A défaut, une description de la fonctionnalité de ta procédure pourrait peut-être faire l'affaire.

Cordialement.
 
Vote positif 0 Vote négatif
maval

maval

XLDnaute Barbatruc
Re : CheckBox

Re,

Papou net
Sa fonctionne nickel je te remercie beaucoup.
Juste une petite modif, Comment je peut lui codé a la checkbox pour que elle marque" Lorsqu'elle est décocher de cocher pour voir le formulaire et lorsqu'elle est cocher de decocher pour masquer le formulaire?

Merci d'avance
 
Vote positif 0 Vote négatif
Papou-net

Papou-net

XLDnaute Barbatruc
Re : CheckBox

RE

Voici un fichier exemple de codage du CheckBox.

J'attire ton attention sur le fait que je te conseille d'utiliser, sur les feuilles, des contrôles ActiveX au lieu de contrôles de formulaire.

Le codage des ActivesX est identique aux objets VBA, ce qui simplifie grandement l'écriture. Pour mémoire, les contrôles de formulaire ont été maintenus pour compatibilité avec les versions d'Excel plus anciennes.

A +

Cordialement.
 

Pièces jointes

  • Exemple CheckBox Max.xlsm
    22.4 KB · Affichages: 25
Vote positif 0 Vote négatif

Discussions similaires

C
  • Question
Autres Enregistrer un code barre dans la cellule avant le titre qui est déja enregistré
Réponses
11
Affichages
497
Chatron
C
L
  • Question
VBA : erreur sur boucle
Réponses
2
Affichages
82
Latias
L
F
  • Question
XL 2019 l'indice n'appartient pas à la sélection
Réponses
9
Affichages
554
job75
job75
E
  • Résolu(e)
XL 2019 inserer une valeur textbox dans la dernière cellule vide horizontalement
Réponses
7
Affichages
327
escudo
E
H
  • Question
Autres mise a jour automatique feuille excel vba
Réponses
2
Affichages
298
HANN
H
U
  • Question
Autres Enregistrer sur Onglet TOTO
Réponses
2
Affichages
388
un internaute
U
VBA_dev_Anne_Marie
  • Résolu(e)
Microsoft 365 VBA : Calculer la date de fin de trimestre
2 3
Réponses
30
Affichages
2 K
eCHO
E
U
  • Résolu(e)
Autres Mettre en couleur ligne avec VBA car MFC occupées (Excel 2003)
2
Réponses
15
Affichages
1 K
un internaute
U
S
  • Question
XL 2016 Code de transfert
Réponses
8
Affichages
763
Seddiki_adz
S
Ferbank
  • Question
XL 2019 modifier une macro
Réponses
2
Affichages
746
Ferbank
Ferbank

Membres actuellement en ligne

2 membres et 54 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 294
Messages
2 086 895
Membres
103 404
dernier inscrit
sultan87