USERFORM : Chek box dasn USERFORM

Version imprimable

04/04/2018, 12h47
ACCESSS

1 pièce(s) jointe(s)

USERFORM : Chek box dasn USERFORM

Bonjour à tous,

Je dois créer un formulaire de modification / consultation d'une base. J'ai télécharger un modèle sur le site de J. Boisgontier.
Mais, malgré de multiples recherches, je n'arrive pas à finaliser la personnalisation de mon Userfom. Je précise que je suis novice en VBA.

J'ai besoin de créer :
Des cases à cocher : selon l'identifiant (donc ligne) doit reporter 1 ou "" dans la colonne de la feuille BD (range avec variable ligne ? )
Code : liste intuitive selon le référentiel des codes se trouvent sur une autre feuille "Code_ano", et enregistrement .

L'affichage doit être le reflet de la BD. Cette dernière est lié à des graphiques, taux, reporting.....

Je vous joint le fichier épuré (en jaune précision du besoin).

D'avance merci de votre aide cela fait un moment que j'essaie de le finaliser

Bonjour,

Partie de la solution pour inscrire ce qui est coché dans les CheckBox dans la feuille BD:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Private Sub b_valid_Click()
   If Me.Enreg <> "" And Me.TextBox1 <> "" Then
      NoEnreg = Me.Enreg
      For k = 1 To Ncol
         '--- attention: ne reprend pas correctement "Observation" en colonne 43
         x = Replace(Me("textBox" & k), " ", "")
         If IsNumeric(x) Then
           f.Cells(NoEnreg, k) = Val(x)
         Else
           f.Cells(NoEnreg, k) = Me("textBox" & k)
         End If
      Next k
      '--- il y a 31 CheckBox
      '--- attention à ne pas ne changer la numérotation
      '--- 13 = colonne M, 14 = colonne N, ... , 31 = colonne AR
      For k = 1 To 31
         If Me("CheckBox" & k) Then
            '--- case cochée = Vrai
            f.Cells(NoEnreg, k + 12) = 1
         Else
            '--- case décochée = Faux
            f.Cells(NoEnreg, k + 12) = ""
         End If
      Next k
      raz
      Me.Enreg = ""
      UserForm_Initialize
   End If
End Sub
b

mais il vous faudra trouver le moyen de faire la chose inverse, cocher les CheckBox dans le formulaire en fonction de ce qui se trouve dans la feuille BD:

Code:

1
2
3
4
5
6
7
8
9
Private Sub ListBox1_Click()
    For k = 1 To 12
      Me("textBox" & k) = Me.ListBox1.Column(k - 1)
    Next k
    Me("textBox13") = "?"        '--- à faire: 'Observation' est en colonne 43 (AS)
    For k = 1 To 31
      'Me("CheckBox" & k) = ???  '--- à faire --- sans doute avec un If
    Next k
End Sub

Bonne continuation.

1 pièce(s) jointe(s)

Bonjour,

Merci pour votre réponse. J'ai modifié mon code et changer le sens des check box afin qu'ils correspondent à mes colonnes.
Par contre j'ai essayé de faire remonter l'info dans mon formulaire mais lorsque je valide toutes les check box sont cochées. Pouvez vous me dire ou se situe mon erreur. Dois je inscrire un code pour chaque checkbox ?

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Private Sub b_valid_Click()
    If Me.Enreg <> "" And Me.TextBox1 <> "" Then
      NoEnreg = Me.Enreg
      For k = 1 To Ncol
         x = Replace(Me("textBox" & k), " ", "")
         If IsNumeric(x) Then
           f.Cells(NoEnreg, k) = Val(x)
         Else
           f.Cells(NoEnreg, k) = Me("textBox" & k)
         End If
 
      'Insertion aide Forum report chek dans bd
          Next k       
      For k = 1 To 32
         If Me("CheckBox" & k) Then '--- case cochée = Vrai
            f.Cells(NoEnreg, k + 12) = 1
         Else                       '--- case décochée = Faux
            f.Cells(NoEnreg, k + 12) = ""
         End If
 
         'Insertion perso report bd dans check
         If f.Cells(NoEnreg, k + 12).Value = "1" Then Sheets("Choix").Select
         Me("CheckBox" & k).Value = True
 
         Next k
      raz
      Me.Enreg = ""
      UserForm_Initialize
    End If
End Sub

J'ai aussi essayé d'étendre la sélection du tableau jusqu'à la colonne BK en modifiant entre autres le Set rng. Si je sélectionne au dessus de la colonne L j'ai un message d'erreur "Erreur d'exécution '-2147024809 : Objet spécifié introuvable".
Pourtant si j'ai bien compris je dois définir ma variable rng afin de définir ma variable Ncol ?

Code:

1
2
3
4
5
6
7
8
Private Sub UserForm_Initialize()
   Set f = Sheets("bd")
   Set Rng = f.Range("A2:L" & f.[A65000].End(xlUp).Row)
   decal = Rng.Row - 1[ATTACH]368607[/ATTACH]
   Ncol = Rng.Columns.Count
   TblTmp = Rng.Value
   Ncol = Rng.Columns.Count - 1
   ReDim choix(1 To UBound(TblTmp))

Merci de votre aide

Bonjour,
Pour récupérer les valeurs des CheckBox, une façon de faire:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Sub ListBox1_Click()
   Dim k As Long, kL As Long
   For k = 1 To Ncol
      Me("textBox" & k) = Me.ListBox1.Column(k - 1)
   Next k
   kL = kLigneDonnees(Me.TextBox1)  '--- voir fonction
   If kL = 0 Then
      '--- ne rien faire, ligne de données non trouvée
   Else
      For k = 1 To 32
         If f.Cells(kL, k + 12) = 1 Then
            Me("CheckBox" & k) = True
         Else
            Me("CheckBox" & k) = False
         End If
      Next k
   End If
End Sub

qui fait appel à la fonction kLigneDonnees (car il ne faut bien distinguer Identifiant et Ligne de données):

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Function kLigneDonnees(kId As Long) As Long   '--- ligne où trouve les données
   '--- il est supposé que l'indifiant est un nombre entier
   Debug.Print "kId: "; kId
   Dim kL As Long, rFind As Range
   kLigneDonnees = 0
   Set rFind = Rng.Find(What:=kId, LookAt:=xlWhole)
   If rFind Is Nothing Then
      MsgBox "Pas trouvé l'identifiant " & kId
   Else
      kLigneDonnees = rFind.Row
   End If
   Set rFind = Nothing
   Debug.Print "kLigneDonnees: "; kLigneDonnees
End Function

fonction qui est également employée pour "valider" les modifications:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Private Sub b_valid_Click()
   Dim kL As Long, k As Long, x As String
   If Me.Enreg <> "" And Me.TextBox1 <> "" Then
      kL = kLigneDonnees(Me.ListBox1.Column(0))  '--- voir fonction
      '--- attention: on ne peut pas mettre Me.TextBox1 vu que cette valeur peut être modifiée
      If kL = 0 Then
         '--- ne rien faire, ligne de données non trouvée
      Else
         For k = 1 To Ncol
            x = Replace(Me("textBox" & k), " ", "")
            If IsNumeric(x) Then
              f.Cells(kL, k) = Val(x)
            Else
              f.Cells(kL, k) = Me("textBox" & k)
            End If
         'Insertion aide Forum
             Next k
         '--- il y a 32 CheckBox
         '--- attention à ne pas ne changer la numérotation
         '--- 13 = colonne M, 14 = colonne N, ... , 32 = colonne AR
         For k = 1 To 32
            If Me("CheckBox" & k) Then
               '--- case cochée = Vrai
               f.Cells(kL, k + 12) = 1
            Else
               '--- case décochée = Faux
               f.Cells(kL, k + 12) = ""
            End If
            'Insertion perso
            'If f.Cells(NoEnreg, k + 12).Value = "1" Then Sheets("Choix").Select '--- utile ?
            'Me("CheckBox" & k).Value = True     '--- à mettre dans raz
         Next k
      End If
      raz
      'Me.Enreg = ""
      UserForm_Initialize
    End If
End Sub

avec un ajout du décochage des CheckBox dans la routine raz:

Code:

1
2
3
4
5
6
7
8
9
10
Sub raz()
   Dim k As Long
   For k = 1 To Ncol
      Me("textBox" & k) = ""
   Next k
   For k = 1 To 32
      Me("CheckBox" & k).Value = False
   Next k
   Me.TextBox1.SetFocus
End Sub

Par ailleurs je ne peux que recommander l'utilisation systématique de Option Explicit pour tous les codes VBA. Cela permet d'éviter de perdre un temps considérable à rechercher des bugs liés à de simples fautes de frappe dans les noms des variables. Pour cela, dans l'éditeur de code, cliquer dans le menu sur Outils / Options et cocher "Déclaration des variables obligatoire". Cela vous demandera d'ajouter des instructions Dim dans la plupart des routines que vous avez réalisées.

Bonne continuation.

11/04/2018, 12h50
ACCESSS

1 pièce(s) jointe(s)

Bonjour

Tout d'abord merci de m'accorder de votre temps.
J'ai fait les modifs cela fonctionne en mode ajout ou consult par contre en modif lorsque je clique sur validation, les lignes identique s'ajoute à la BD. J'ai beau essayé de chercher mais action nul voir pire
Dans la Private KligneDonnées l'identifiant sera en format "Texte" (il commence par 0)

L'option "Déclaration des variables obligatoire" est déjà coché. Merci pour ce conseil, il est effectivement très utile de l'utiliser. Je modifie en ce sens.

Cordialement
11/04/2018, 18h26
EricDgn

1 pièce(s) jointe(s)

Bonjour,
Il faut corriger la fonction kLigneDonnees pour ce qui est de cette ligne:

Code:

Set rFind = RNG.Columns(1).Find(What:=kId, LookAt:=xlWhole)

la recherche ne devant s'effectuer que sur la colonne A.
Pour ce qui est de Option Explicit, il faut l'ajouter manuellement pour tous les modules déjà créés.
Bonne continuation.

Bonjour,

Les checkbox fonctionnent!! Un grand merci.

Par contre j'ai cherché 2 heures durant comment étendre l'affichage de mes TEXTBOX (TEXTBOX45 = colonne 45)
J'ai essayé de modifier le range "A2:L" par "A2:BK" mais je ne peux aller au delà de "M" et NCOL par columns.COUNT mais message d'erreur.

Pouvez vous m'aider ?

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Private Sub UserForm_Initialize()
   Set f = Sheets("bd")
   Set Rng = f.Range("A2:L" & f.[A65000].End(xlUp).Row)
   decal = Rng.Row - 1
   Ncol = Rng.Columns.Count
   TblTmp = Rng.Value
   Ncol = Rng.Columns.Count - 1
   ReDim choix(1 To UBound(TblTmp))
   For i = LBound(TblTmp) To UBound(TblTmp)
     TblTmp(i, Ncol + 1) = i + decal
     For k = 1 To Ncol
       choix(i) = choix(i) & TblTmp(i, k) & "|"
       If k >= 3 And k <= 5 Then TblTmp(i, k) = Format(TblTmp(i, k), "00000000")
     Next k
     choix(i) = choix(i) & (i + decal) & "|"
   Next i
   Call TriS(choix, 1, UBound(choix))
   Call Tri(TblTmp, 1, LBound(TblTmp), UBound(TblTmp))
   Me.ListBox1.List = TblTmp
   b_ajout_Click
End Sub
 
 
Private Sub UserForm_Initial()
  Set f = Sheets("BD")
  nbcol = f.[A1].CurrentRegion.Columns.Count
  Me.ListBox1.ColumnCount = nbcol
  'Set plage = f.[A1].CurrentRegion 'Original JB
  Set plage = f.Range("a1").End(xlDown).Select 'Modifié
  Set plage = plage.Offset(1).Resize(plage.Rows.Count - 1)
  Me.ListBox1.List = plage.Value
  x = 15
  y = Me.ListBox1.Top - 12
  For i = 1 To nbcol
    retour = Me.Controls.Add("Forms.Label.1", "Label" & i, True)
    Me("label" & i).Caption = f.Cells(1, i)
    Me("label" & i).Top = y
    Me("label" & i).Left = x
    x = x + f.Columns(i).Width * 1.1
    temp = temp & f.Columns(i).Width * 1.1 & ";"
  Next
  Me.ListBox1.ColumnWidths = temp
End Sub

Bonjour,
Pas vraiment compris où se trouve le problème, mais j'ai constaté qu'avec BK, le formulaire RechIntuit2 plante au lancement au niveau de la routine raz()
Code:

1 2 3 4 5 6 7 8 9 10 11 Sub raz() Dim k As Long For k = 1 To NCOL Debug.Print "textBox" & k '---- plante sur k = 13 --- pas de textbox13 dans le formulaire ? Me("textBox" & k) = "" Next k For k = 1 To 32 Me("CheckBox" & k).Value = False Next k Me.TextBox1.SetFocus End Sub
Le Debug.Print permet de le constater.
Bonne continuation.