Discussion :

[titi57]

bonjour

afin d'ajouter une bouton plus dans mon forulaire de saisie je voudrais ajoutée un bouton pour ne plus ecrire le numero des tirs

en effet des mon masque de saisie des serie un de vous ma données le code VBA suivant pour ne plus ecrire manuellement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
Option Compare Database: Option Explicit
Private Sub Ctl__Click()
 
    If IsNull(Me.Num_serie) Then
        Me.Num_serie = CalculerProchainNoSerie(Me.Parent.Id_match, Me.Parent.id_tireur)
    End If
 
End Sub
 
Private Function CalculerProchainNoSerie(prmIdMatch As Variant, prmIdTireur As Variant) As Long
    Dim result As Long
 
    Dim dernierNoSerie As Variant
    Dim critere As String
    critere = "Id_match=" & prmIdMatch & " and Id_tireur=" & prmIdTireur
    result = Nz(DMax("Num_serie", "serie", critere), 0) + 1
 
    CalculerProchainNoSerie = result
End Function
Private Sub Form_AfterDelConfirm(Status As Integer)
    Call GererMaxSerie
End Sub
 
Private Sub Form_AfterInsert()
    Call GererMaxSerie
End Sub
 
Sub Form_Current()
 
    On Error GoTo Form_Current_Err
 
    Dim ParentDocName As String
 
    ParentDocName = Me.Parent.Name
    Me.Parent![nouveautir].Requery
 
Form_Current_Exit:
    Exit Sub
 
Form_Current_Err:
 
    Select Case Err.Number
        Case 2452
            'Ne rien faire, c'est une erreur prévue
 
        Case Else
            'Autre cas d'erreur non prévue
            MsgBox "Erreur : " & Err.Number & ", " & Err.Description
 
    End Select
 
    Resume Form_Current_Exit
End Sub
 
Private Function LireNombreSerie() As Long
    'Retrouve le nombre de séries actuellement enregistrées
    Dim result As Long
 
    Dim r As DAO.Recordset: Set r = Me.RecordsetClone
    r.MoveLast 'Force la lecture de tous les energistrements pour savoir combien il y en a.
    result = r.RecordCount
    r.Close: Set r = Nothing 'Ferme l'objet Recordset et libère explicitement la mémoire associée.
 
    LireNombreSerie = result
End Function
 
Private Function LireMatchNomDiscipline(prmIdMatch As Variant, prmIdTireur As Variant) As Variant
    'J'ai mis des variant pour pouvoir gérer les nulls
    Dim result As Variant: result = Null
 
    If Not IsNull(prmIdMatch) And Not IsNull(prmIdTireur) Then
        'Va chercher le nom de la discipline
        result = DFirst("Nom_Discipline", "Match", "[Id_match]=" & prmIdMatch & " and [Id_Tireur]=" & prmIdTireur)
    End If
 
    LireMatchNomDiscipline = result
End Function
 
Private Function LireNbMaxSerieDiscipline(prmNomDiscipline As Variant) As Long
    'Donne le nombre maximum de séries autorisées pour la discipline choisie
    Dim result As Long
 
    If Not IsNull(prmNomDiscipline) Then
        result = Nz(DFirst("Nb_serie", "Discipline", "[Nom_discipline]=""" & prmNomDiscipline & """"), 0)
    End If
 
    LireNbMaxSerieDiscipline = result
 
End Function
 
Private Function MaxSerieAtteint() As Boolean
    'Détermine si on atteint le nombre maximum de séries pour la discipline choisie
    Dim result As Boolean
 
    Dim nomDiscipline As Variant: nomDiscipline = LireMatchNomDiscipline(Me![Id_match], Me![id_tireur]) 'Le me! permet d'accéder aux champs de la source de données, même s'ils ne sont pas affichés
    Dim nombreMaxSerie As Long: nombreMaxSerie = LireNbMaxSerieDiscipline(nomDiscipline)
    Dim nombreSerie As Long: nombreSerie = LireNombreSerie()
 
    If nombreSerie >= nombreMaxSerie Then
            result = True
        Else
            result = False
    End If
 
    MaxSerieAtteint = result
 
End Function
 
Private Sub GererMaxSerie()
 
    If MaxSerieAtteint() Then 'If MaxSerieAtteint() Then est équivalent à If MaxSerieAtteint()=true Then
            Me.AllowAdditions = False
            MsgBox "Vous avez atteind le maximum de " & LireNbMaxSerieDiscipline(LireMatchNomDiscipline(Me![Id_match], Me![id_tireur])) & " série(s) autorisée(s).", vbInformation
        Else
            Me.AllowAdditions = True
    End If
 
End Sub

je voudrais le même pour mais tir cela évitera d’écrire a chaque fois 1 2 3 4 5 6 7 8 9 10

en vous remerciant d'avance