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
| Private Function editControl(KeyAscii As Integer, Optional Suppr As Boolean = False)
Dim s As Long 'sauvegarde de la position du curseur
Dim c As String 'caractère à insérer
Dim txt As String 'texte résultat
With ActiveControl
If Suppr Then
'supprime
If (.SelStart = Len(ActiveControl)) And (.SelLength = 0) Then Exit Function
s = .SelStart
If .SelLength = 0 Then .SelLength = 1
Else
Select Case KeyAscii
Case 8
'delete
If (.SelStart = 0) And (.SelLength = 0) Then Exit Function
If (.SelStart > 0) And (.SelLength = 0) Then
.SelStart = .SelStart - 1
.SelLength = 1
End If
s = .SelStart
If .SelLength = 0 Then .SelLength = 1
Case 32 To 126, 160 To 255
'caractères supportés par windows
s = .SelStart + 1
c = Chr(KeyAscii)
Case Else
Exit Function
End Select
End If
txt = Left(ActiveControl, .SelStart) & c & Right(ActiveControl, Len(txtvaleur) - (.SelStart + .SelLength))
Application.Echo False
oRs.Fields(.ControlSource) = txt
oRs.Update
.SelStart = s
Application.Echo True
End With
End Function
Private Sub txtvaleur_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 46 Then editControl 0, True 'supprime
End Sub
Private Sub txtvaleur_KeyPress(KeyAscii As Integer)
editControl KeyAscii
End Sub |
Partager