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 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242
| Option Compare Database
Option Explicit
--------------------------------------
Private WithEvents clMouseWHeel As MouseWheelDVP.cMouseWheel
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetFocus Lib "user32" () As Long
Private Const WM_VSCROLL = &H115
Private Const SB_LINEUP = 0
Private Const SB_LINEDOWN = 1
------------------------------------
Private Sub clMouseWHeel_MouseWheel(Cancel As Integer, FormScroll As Integer, Delta As Long)
Cancel = True
Dim lhWnd As Long
On Error Resume Next
If Screen.ActiveControl.Name <> "Bloc" Then Exit Sub
If Err.Number <> 0 Then Exit Sub
On Error GoTo 0
lhWnd = GetFocus
If Delta < 0 Then
SendMessage lhWnd, WM_VSCROLL, SB_LINEDOWN, 0&
Else
SendMessage lhWnd, WM_VSCROLL, SB_LINEUP, 0&
End If
End Sub
------------------------------------------
Private Sub Commande108_DblClick(Cancel As Integer)
Me.AllowAdditions = True
ActiveTextBox True
On Error GoTo Err_Commande108_Click
DoCmd.GoToRecord , , acNewRec
Exit_Commande108_Click:
Exit Sub
Err_Commande108_Click:
MsgBox Err.Description
Resume Exit_Commande108_Click
ActiveTextBox True
End Sub
-------------------------------------------
Private Sub Form_Close()
If Not (clMouseWHeel Is Nothing) Then
Set clMouseWHeel = Nothing
End If
End Sub
--------------------------------------
Private Sub Form_Load()
Set clMouseWHeel = New MouseWheelDVP.cMouseWheel
Set clMouseWHeel.Form = Me
End Sub
---------------------------------------------------
Sub ActiveTextBox(etat As Boolean)
Dim oCtrl As Control
For Each oCtrl In Me.Controls
If TypeOf oCtrl Is TextBox Then
oCtrl.Enabled = etat
End If
Next oCtrl
End Sub
-------------------------------------------------------
Private Sub C_Click()
If Me.C.Value = True Then
Me.EC.Value = False
Me.RT.Value = False
End If
End Sub
----------------------------------------------------------
Private Sub Case_Refus_Click()
If Me.Case_Refus.Value = True Then
Me.Ok_prise_en_Charge.Value = False
End If
End Sub
------------------------------------------
Private Sub Commande18_Click()
On Error GoTo Err_Commande18_Click
DoCmd.Close
Exit_Commande18_Click:
Exit Sub
Err_Commande18_Click:
MsgBox Err.Description
Resume Exit_Commande18_Click
End Sub
---------------------------------------
Private Sub New_enregis_Click()
On Error GoTo Err_New_enregis_Click
Dim stDocName As String
stDocName = "Valider"
DoCmd.RunMacro stDocName
Exit_New_enregis_Click:
Exit Sub
Err_New_enregis_Click:
MsgBox Err.Description
Resume Exit_New_enregis_Click
End Sub
----------------------------------------
Private Sub Commande34_Click()
On Error GoTo Err_Commande34_Click
Dim stDocName As String
stDocName = "New sinistre"
DoCmd.RunMacro stDocName
Exit_Commande34_Click:
Exit Sub
Err_Commande34_Click:
MsgBox Err.Description
Resume Exit_Commande34_Click
End Sub
---------------------------------------
Private Sub Commande103_Click()
DoCmd.RunCommand acCmdSaveRecord
ActiveTextBox False
End Sub
Private Sub Commande106_Click()
ActiveTextBox True
End Sub
-------------------------------------------
Private Sub Commande112_Click()
DoCmd.RunCommand acCmdSaveRecord
DoCmd.OpenReport "Rq_Secure1", acViewNormal, , "Réf_Sinistre = '" & Me.Réf_Sinistre & "'"
End Sub
-------------------------------------------
Private Sub Conces_AfterUpdate()
Me.Conces = UCase(Me.Conces)
End Sub
------------------------------------------
Private Sub Date_de_la_panne_AfterUpdate()
Dim DateStart As Date
Dim DateEnd As Date
DateStart = DLookup("[Date_début_d'effet]", "Presses", "[N°Contrat] = '" & Me.n°Police & "'")
DateEnd = DLookup("[Date_fin_de_garantie]", "Presses", "[N°Contrat] = '" & Me.n°Police & "'")
If Me.Date_de_la_panne < DateStart Then
MsgBox "Contrat pas commencé", vbExclamation, "Validité du contrat"
Exit Sub
ElseIf Me.Date_de_la_panne > DateEnd Then
MsgBox "Contrat terminé", vbExclamation, "Validité du contrat"
Exit Sub
Else
MsgBox "Contrat en cours", vbInformation, "Validité du contrat"
End If
End Sub
------------------------------------------------
Private Sub EC_Click()
If Me.EC.Value = True Then
Me.C.Value = False
Me.RT.Value = False
End If
End Sub
---------------------------------------------
Private Sub Form_Open(Cancel As Integer)
ActiveTextBox False
End Sub
--------------------------------------------
Private Sub nbr_de_balles_AfterUpdate()
If Me.Type_de_presse_2.Column(2) = "BR" And Me.nbr_de_balles > 12000 Then
MsgBox "Usage Dépassé maximum 12 000 pour les presses à balles rondes"
Else
If Me.Type_de_presse_2.Column(2) = "BC" And Me.nbr_de_balles > 30000 Then
MsgBox "Usage Dépassé maximum 30 000 pour les presses à balles rectangulaires"
End If
End If
End Sub
---------------------------------------------------
Private Sub Ok_prise_en_Charge_Click()
If Me.Ok_prise_en_Charge.Value = True Then
Me.Case_Refus.Value = False
End If
End Sub
------------------------------------------
Private Sub Recherche_Click()
On Error GoTo Err_Recherche_Click
Screen.PreviousControl.SetFocus
DoCmd.DoMenuItem acFormBar, acEditMenu, 10, , acMenuVer70
Exit_Recherche_Click:
Exit Sub
Err_Recherche_Click:
MsgBox Err.Description
Resume Exit_Recherche_Click
End Sub
------------------------------------------
Private Sub Commande36_Click()
On Error GoTo Err_Commande36_Click
Dim stDocName As String
stDocName = "Voir sinistres"
DoCmd.RunMacro stDocName
Exit_Commande36_Click:
Exit Sub
Err_Commande36_Click:
MsgBox Err.Description
Resume Exit_Commande36_Click
End Sub
------------------------------------
Private Sub Commande37_Click()
On Error GoTo Err_Commande37_Click
Dim stDocName As String
stDocName = "Modif sinistres"
DoCmd.RunMacro stDocName
Exit_Commande37_Click:
Exit Sub
Err_Commande37_Click:
MsgBox Err.Description
Resume Exit_Commande37_Click
End Sub
-------------------------------------
Private Sub Réf_piéce_AfterUpdate()
Me.Réf_piéce = UCase(Me.Réf_piéce)
End Sub
------------------------------------
Private Sub RT_Click()
If Me.RT.Value = True Then
Me.EC.Value = False
Me.C.Value = False
End If
End Sub
---------------------------------------
Private Sub Commande90_Click()
On Error GoTo Err_Commande90_Click
DoCmd.GoToRecord , , acPrevious
Exit_Commande90_Click:
Exit Sub
Err_Commande90_Click:
MsgBox Err.Description
Resume Exit_Commande90_Click
End Sub
-------------------------------------
Private Sub Commande91_Click()
On Error GoTo Err_Commande91_Click
DoCmd.GoToRecord , , acNext
Exit_Commande91_Click:
Exit Sub
Err_Commande91_Click:
MsgBox Err.Description
Resume Exit_Commande91_Click
End Sub
---------------------------------------
Private Sub Commande110_Click()
On Error GoTo Err_Commande110_Click
Dim stDocName As String
stDocName = "Ouvrir Dsciptif"
DoCmd.RunMacro stDocName
Exit_Commande110_Click:
Exit Sub
Err_Commande110_Click:
MsgBox Err.Description
Resume Exit_Commande110_Click
End Sub |
Partager