Textbox format €uros

[maval]

Bonjours,

J'ai sur mon Formulaire un textbox avec le code suivant pour afficher le format €uros qui fonctionne très bien.

Private Sub CommandButton1_Click()
       With Sheets("feuil1")

.Cells(18, 2) = TxBx_Montant.Value '€uros automatique

End With
End Sub

'Textbox "TxBx_Montant" en format €uros
Private Sub TxBx_Montant_Change()
Dim CHN As String, Start As Integer
CHN = TxBx_Montant.Text
Start = TxBx_Montant.SelStart
If CHN <> "" Then
If Right(CHN, 1) <> "€" Then
CHN = RTrim(CHN) & "  €"
TxBx_Montant.Text = CHN
TxBx_Montant.SelStart = Start
 
End If
End If
End Sub

Il affiche le sigle € sur le formulaire mais il ne copie pas sur ma feuille.
Je recherche la modification de mon code pour qu'il affiche sur ma feuille.

Je vous remercie de votre aide.

Cordialement

Max

 

[frangy]

Re : Textbox format €uros

Bonjour,

Essaie avec

.Cells(18, 2) = Format(TxBx_Montant.Value, "#,##0.00 €") '€uros automatique

A+

 

[maval]

Re : Textbox format €uros

Bonjour Frangy

Non sa ne fonctionne pas mais j'ai ceci qui fonctionne très bien si sa peut servir a quelqu'un?

Private Sub CommandButton1_Click()
       With Sheets("feuil1")

.Cells(18, 2) = TxBx_Montant.Value '€uros automatique

End With
End Sub

'Textbox "TxBx_Montant" en format €uros
Private Sub TxBx_Montant_Change()
Dim CHN As String, Start As Integer
CHN = TxBx_Montant.Text
Start = TxBx_Montant.SelStart
If CHN <> "" Then
If Right(CHN, 1) <> "€" Then
CHN = RTrim(CHN) & "  €"
TxBx_Montant.Text = CHN
TxBx_Montant.SelStart = Start
 
End If
End If
End Sub

' format €uros
Private Sub TxBx_Montant_AfterUpdate()
    TxBx_Montant.Text = FormatEuro(TxBx_Montant.Text)
    TxBx_Montant.SelStart = Len(TxBx_Montant.Value) - 1
End Sub

' fonction perso pour retourner le format Euro
Private Function FormatEuro(ByVal Txt As String) As String
    Txt = Replace(Replace(Replace(Txt, ".", ","), " €", ""), " ", "")
    FormatEuro = Format(CDbl(Txt), "### ### ##0.00 €")
End Function

Merci

@+

Max