Evenement AfterUpdate pour module de class textbox

[cedvautrin25]

Bonsoir à tous,

Je voudrais faire une mise en forme monétaire 18 textbox en passant par un module de classe.
Or d'après mes recherche, les modules de classe textbox ne gèrent pas l’événement AfterUpdate...
Y a t'il une solution pour gérer ceci dans un module de classe ou faut il que j'écrive les 18 textbox_afterupdate dans ma userform ?

Merci

 

[job75]

Re : Evenement AfterUpdate pour module de class textbox

Bonsoir;

Les évènements AfterUpdate et Exit ne sont pas gérés par les modules de classe.

Vous devriez vous en tirer avec l'évènement Change, ce sera un peu plus compliqué.

A+

 

[Dranreb]

Re : Evenement AfterUpdate pour module de class textbox

Bonsoir.

Je suis sur la piste d'un module de classe qui permettrait d'avertir un Userform de tout contrôle perdant le focus.
Il ne resterait plus qu'a y mettre un Tag indiquant qu'il doit faire l'objet d'un traitement particulier dans cette procédure.

 

[Dranreb]

Re : Evenement AfterUpdate pour module de class textbox

Ouais, bon… Ça ne me plait pas plus que ça parce que ça empêche la Private Sub UserForm_Activate de se terminer.
J'aurais préféré pouvoir le faire avec un Timer API mais l'opérateur AddressOf n'accepte pas d'être suivi d'une procédure de module objet.

Edit: Suis-je bête. Il n'y a pas besoin d'un module de classe pour faire ça :

Option Explicit
Dim CtrlActif As MSForms.Control, ÇaRoule As Boolean

Private Sub UserForm_Initialize()
Rem. —— Les instructions d'initialisation.
' Si la UserForm_Initialize ne se termine pas
' l'Userform peut ne pas s'afficher.
End Sub

Private Sub UserForm_Activate()
If ÇaRoule Then Exit Sub
ÇaRoule = True
Do While ÇaRoule: DoEvents
   If Not CtrlActif Is Me.ActiveControl Then
      If Not CtrlActif Is Nothing Then PerdFocus CtrlActif
      Set CtrlActif = Me.ActiveControl: End If: Loop
End Sub

Private Sub UserForm_Deactivate()
ÇaRoule = False
End Sub

Private Sub PerdFocus(ByVal Ctrl As MSForms.Control)
Me.Label1.Caption = Ctrl.Name & ".Text = """ & Ctrl.Text & """."
End Sub

 

[cedvautrin25]

Re : Evenement AfterUpdate pour module de class textbox

Ouais, bon… Ça ne me plait pas plus que ça parce que ça empêche la Private Sub UserForm_Activate de se terminer.
J'aurais préféré pouvoir le faire avec un Timer API mais l'opérateur AddressOf n'accepte pas d'être suivi d'une procédure de module objet.

Edit: Suis-je bête. Il n'y a pas besoin d'un module de classe pour faire ça :

Option Explicit
Dim CtrlActif As MSForms.Control, ÇaRoule As Boolean

Private Sub UserForm_Initialize()
Rem. —— Les instructions d'initialisation.
' Si la UserForm_Initialize ne se termine pas
' l'Userform peut ne pas s'afficher.
End Sub

Private Sub UserForm_Activate()
If ÇaRoule Then Exit Sub
ÇaRoule = True
Do While ÇaRoule: DoEvents
   If Not CtrlActif Is Me.ActiveControl Then
      If Not CtrlActif Is Nothing Then PerdFocus CtrlActif
      Set CtrlActif = Me.ActiveControl: End If: Loop
End Sub

Private Sub UserForm_Deactivate()
ÇaRoule = False
End Sub

Private Sub PerdFocus(ByVal Ctrl As MSForms.Control)
Me.Label1.Caption = Ctrl.Name & ".Text = """ & Ctrl.Text & """."
End Sub

Bonsoir,

Comme vous le dite, c'est pas top si la Private Sub UserForm_Activate ne se termine pas... ensuite je ne vois pas comment gérer mes 18 textbox avec Private Sub PerdFocus...

 

[laetitia90]

Re : Evenement AfterUpdate pour module de class textbox

bonsoir tous
une approche sans passer par lostfocus & gotfocus a voir ???


ps:: dans la classe MouseDown

For i = 1 To 18 & non For i = 1 To 14

 

[Dranreb]

Re : Evenement AfterUpdate pour module de class textbox

Bonsoir.

je ne vois pas comment gérer mes 18 textbox avec Private Sub PerdFocus...

Pourquoi ?
Vous les y avez là, en tant que Ctrl, tous les TextBox susceptibles d'avoir été modifiés. Il ne reste plus qu'à trouver un moyen de savoir si c'en est un à traiter. Le plus simple c'est de leur mettre un début de nom spécifique et de le tester dans la procédure. Ou alors de mettre un même contenu à leurs Tag dans la fenêtre de propriété.
Sinon effectivement il y a peut être moyen de prendre la direction diamétralement opposée comme le suggère laetitia90. Non seulement on n'attend pas que l'opérateur ait quitté le contrôle pour ne pas le déranger pendant sa saisie mais on l'assiste pendant la frappe. Ça permet déjà de résoudre le problème de la virgule tapée comme un point. L'essentiel, après tout c'est que la TextBoxX.Text puisse être converti en un Double ou un Currency.

Edit: En fait la classe de laetitia90 fait beaucoup plus de choses que je ne le croyais.
Mais je crois aussi que sa KeyPress doit être réécrite comme ça :

Private Sub txt_KeyPress(ByVal K As MSForms.ReturnInteger)
If K = Asc(".") Then K = Asc(",")
If Not IsNumeric(Left$(txt.Text, txt.SelStart) & Chr$(K) & Mid(txt.Text, txt.SelStart + 1)) Then K = 0
End Sub

… à condition qu'il ne faille pas pouvoir entrer de façon simple des montants négatifs …

Je lui adjoindrais peut être une propriété Valeur pour ne plus se poser de question sur cette valeur à ranger dans une cellule :

Public Property Let Valeur(ByVal V)
If IsNumeric(V) Then txt.Text = Format(txt, "0.00 €") Else txt.Text = ""
End Property
Public Property Get Valeur()
If txt.Text = "" Then Valeur = Empty Else Valeur = CDbl(txt.Text)
End Property

Ou la récupérer d'une cellule d’ailleurs.

 

[Dranreb]

Re : Evenement AfterUpdate pour module de class textbox

Bonsoir.

c'est pas top si la Private Sub UserForm_Activate ne se termine pas

Alors voila une approche qui n'empêche aucune procédure de se terminer.

 

[job75]

Re : Evenement AfterUpdate pour module de class textbox

Bonjour à tous,

Comme je disais au post #2 :

Private Sub txt_Change()
Dim x$, p%
x = Replace(txt, ",", ".")
p = txt.SelStart 'mémorise
txt = Format(Val(x), "0.00 €")
txt.SelStart = p: txt.SelLength = IIf(InStr(Mid(x, 1, p), "."), 1, 0)
End Sub

Fichier - celui de Laetitia - joint.

A+

 

[Dranreb]

Re : Evenement AfterUpdate pour module de class textbox

Bonjour.
C'est vrai, job75, que dans la mesure où on peut le faire comme ça, ça a fort peu d'intérêt de vouloir le faire à l'évènement AfterUpdate, qu'il soit réel ou simulé. Ce n'est même pas gênant que ce _Change puisse s'appeler récursivement, mais une seule fois, au txt = Format(…

 

[job75]

Re : Evenement AfterUpdate pour module de class textbox

Re,

C'est mieux avec ce fichier (2) :

Private Sub txt_Change()
Dim x$, p%
x = Replace(txt, ",", ".")
p = txt.SelStart - (x = "0") + (x Like "0?*.*") 'mémorise
txt = IIf(IsNumeric(Left(x, 1)), Format(Val(x), "0.00 €"), "")
txt.SelStart = p
End Sub

Edit : j'ai eu du mal a trouver la formule pour le calcul de p.

A+

 

[job75]

Re : Evenement AfterUpdate pour module de class textbox

Bonjour le forum,

Pour le fun, si l'on veut que toutes les TextBoxes soient remplies dans l'ordre :

Public WithEvents txt As MSForms.TextBox
Public WithEvents btn As MSForms.CommandButton

Private Sub txt_Change()
Dim i As Byte, x$, p%
For i = 1 To 50
  With txt.Parent("T" & i)
    If .Name = txt.Name Then Exit For
    If .Text = "" Then txt = "": .SetFocus: Exit Sub
  End With
Next
x = Replace(txt, ",", ".")
p = txt.SelStart - (x = "0") + (x Like "0?*.*") 'mémorise
txt = IIf(IsNumeric(Left(x, 1)), Format(Val(x), "0.00 €"), "")
txt.SelStart = p
End Sub

Private Sub btn_Click()
If btn.Caption = "Valider" Then
  Dim i As Byte
  On Error Resume Next
  For i = 1 To 50
    With btn.Parent("T" & i)
      If IsError(.Text) Then Exit For
      If .Text = "" Then .SetFocus: Exit Sub
    End With
  Next
  MsgBox "OK toutes les TextBoxes sont remplies..."
End If
If btn.Caption = "Fermer" Then Unload btn.Parent
End Sub

Fichier (3).

Bonne journée.

 

[job75]

Re : Evenement AfterUpdate pour module de class textbox

Re,

Toujours pour le fun une autre manière de faire :

Public WithEvents txt As MSForms.TextBox
Public WithEvents btn As MSForms.CommandButton

Private Sub txt_Change()
Dim x$, p%
For i = 1 To UBound(t)
  With t(i).txt
    If .Name = txt.Name Then Exit For
    If .Text = "" Then txt = "": .SetFocus: Exit Sub
  End With
Next
x = Replace(txt, ",", ".")
p = txt.SelStart - (x = "0") + (x Like "0?*.*") 'mémorise
txt = IIf(IsNumeric(Left(x, 1)), Format(Val(x), "0.00 €"), "")
txt.SelStart = p
End Sub

Private Sub btn_Click()
If btn.Caption = "Valider" Then
  Dim c As Control
  For i = 1 To UBound(t)
    Set c = t(i).txt
    If Not c Is Nothing Then If c.Text = "" Then c.SetFocus: Exit Sub
  Next
  MsgBox "OK toutes les TextBoxes sont remplies..."
End If
If btn.Caption = "Fermer" Then Unload btn.Parent
End Sub

Voyez Module1 où les tableaux t et b ainsi que i sont déclarés Public.

Fichier (4).

A+