La virgule et le point textbox vers cellule

bonjour,

j'ai un problème de transferts de ma textbox à la cellule lorsque j'utilise le point du pavé numerique cellui-ci n'est pas reconnu du coup lorceque je mets 5.5 cela es transcrit par 55

si vous avez besoin de plus d'info n'hesité pas d'avance merci

Private Sub CommandButton2_Click()

Dim DAT1 As Long, DEST1 As Long, AWB1 As Long, REF1 As Long, NBR1 As Long, PDS1 As Long, COMM1 As Long

Dim DAT As Date, DEST As String, AWB As Double, REF As String, NBR As Integer, PDS As Double, COMM As String, date2 As Date

DAT1 = Range("A" & Rows.Count).End(xlUp).Row

dat2 = Range("A" & DAT1).Value

DAT1 = DAT1 + 1

If Me.TextBox2 = "" Then

MsgBox "merci de remplir la destination"

Exit Sub

End If

DEST = TextBox2.Value

If Me.TextBox3 = "" Then

MsgBox "merci de remplir l'AWB"

Exit Sub

End If

AWB = TextBox3.Value

If Me.TextBox4 = "" Then

MsgBox "merci de remplir la REF"

Exit Sub

End If

REF = TextBox4.Value

If Me.TextBox5 = "" Then

MsgBox "merci de remplir le nombre"

Exit Sub

End If

NBR = TextBox5.Value

If Me.TextBox6 = "" Then

MsgBox "merci de remplir le poids"

Exit Sub

End If

PDS = TextBox6.Value

If Me.TextBox2 <> "" Then

COMM = TextBox7.Value

COMM1 = Range("A" & Rows.Count).End(xlUp).Row + 1

Range("G" & COMM1) = COMM

End If

DAT = TextBox1.Value

If DAT <> dat2 Then

ActiveSheet.Range(Cells(3, 1), Cells(3, 7)).Copy

ActiveSheet.Range("a" & DAT1).PasteSpecial xlPasteValues

ActiveSheet.Range(Cells(DAT1, 1), Cells(DAT1, 7)).Select

Selection.Font.Bold = True

Selection.Font.Size = 14

Selection.HorizontalAlignment = xlCenter

Selection.Interior.Color = RGB(255, 255, 0)

Selection.Font.Color = RGB(0, 0, 0)

End If

DAT1 = Range("A" & Rows.Count).End(xlUp).Row + 1

Range("A" & DAT1) = DAT

DEST1 = Range("B" & Rows.Count).End(xlUp).Row + 1

Range("B" & DEST1) = DEST

AWB1 = Range("C" & Rows.Count).End(xlUp).Row + 1

Range("C" & AWB1) = AWB

REF1 = Range("D" & Rows.Count).End(xlUp).Row + 1

Range("D" & REF1) = REF

NBR1 = Range("E" & Rows.Count).End(xlUp).Row + 1

Range("E" & NBR1) = Val(Replace(Me.Controls(NBR), ",", "."))

PDS1 = Range("F" & Rows.Count).End(xlUp).Row + 1

Range("F" & PDS1) = Format(PDS, "0.00")

ActiveSheet.Range(Cells(DAT1, 1), Cells(DAT1, 7)).Select

Selection.Font.Bold = False

Selection.Font.Size = 11

Selection.HorizontalAlignment = xlCenter

Selection.Interior.Color = xlNone

Selection.Font.Color = RGB(0, 0, 0)

Unload UserForm1

End Sub

Bonjour,

remplacer la fonction "Val" par la fonction "Cdec"

 Range("E" & NBR1) =Cdec(Replace(Me.Controls(NBR), ",", "."))

merci pour le code mais ca marche encore moins maintenant ca donne un code erreur

run-time error 2147024809 (80070057)

invalid argument

Essayer ceci

Range("E" & NBR1) = CDec(Me.Controls(NBR))

merci pour votre aide mais le probleme demarre deja plus haut je pense car en maitant une msgbox la virgule disparait plus haut.

en bleu et rouge

Private Sub CommandButton2_Click()

Dim DAT1 As Long, DEST1 As Long, AWB1 As Long, REF1 As Long, NBR1 As Long, PDS1 As Long, COMM1 As Long

Dim DAT As Date, DEST As String, AWB As Double, REF As String, NBR As Integer, PDS As Double, COMM As String, date2 As Date

DAT1 = Range("A" & Rows.Count).End(xlUp).Row

dat2 = Range("A" & DAT1).Value

DAT1 = DAT1 + 1

If Me.TextBox2 = "" Then

MsgBox "merci de remplir la destination"

Exit Sub

End If

DEST = TextBox2.Value

If Me.TextBox3 = "" Then

MsgBox "merci de remplir l'AWB"

Exit Sub

End If

AWB = TextBox3.Value

If Me.TextBox4 = "" Then

MsgBox "merci de remplir la REF"

Exit Sub

End If

REF = TextBox4.Value

If Me.TextBox5 = "" Then

MsgBox "merci de remplir le nombre"

Exit Sub

End If

NBR = TextBox5.Value

If Me.TextBox6 = "" Then

MsgBox "merci de remplir le poids"

Exit Sub

End If

PDS = TextBox6.Value

msgbox PDS

If Me.TextBox2 <> "" Then

COMM = TextBox7.Value

COMM1 = Range("A" & Rows.Count).End(xlUp).Row + 1

Range("G" & COMM1) = COMM

End If

DAT = TextBox1.Value

If DAT <> dat2 Then

ActiveSheet.Range(Cells(3, 1), Cells(3, 7)).Copy

ActiveSheet.Range("a" & DAT1).PasteSpecial xlPasteValues

ActiveSheet.Range(Cells(DAT1, 1), Cells(DAT1, 7)).Select

Selection.Font.Bold = True

Selection.Font.Size = 14

Selection.HorizontalAlignment = xlCenter

Selection.Interior.Color = RGB(255, 255, 0)

Selection.Font.Color = RGB(0, 0, 0)

End If

DAT1 = Range("A" & Rows.Count).End(xlUp).Row + 1

Range("A" & DAT1) = DAT

DEST1 = Range("B" & Rows.Count).End(xlUp).Row + 1

Range("B" & DEST1) = DEST

AWB1 = Range("C" & Rows.Count).End(xlUp).Row + 1

Range("C" & AWB1) = AWB

REF1 = Range("D" & Rows.Count).End(xlUp).Row + 1

Range("D" & REF1) = REF

NBR1 = Range("E" & Rows.Count).End(xlUp).Row + 1

Range("E" & NBR1) = Val(Replace(Me.Controls(NBR), ",", "."))

PDS1 = Range("F" & Rows.Count).End(xlUp).Row + 1

Range("F" & PDS1) = Format(PDS, "0.00")

ActiveSheet.Range(Cells(DAT1, 1), Cells(DAT1, 7)).Select

Selection.Font.Bold = False

Selection.Font.Size = 11

Selection.HorizontalAlignment = xlCenter

Selection.Interior.Color = xlNone

Selection.Font.Color = RGB(0, 0, 0)

Unload UserForm1

end sub

Et en mettant 5,5 au lieu de 5.5

Oui la ca fonctionne mais le but es d'utiliser le paver numérique

Bonjour

pour les Texbox numérique il faut mètre un keyPress

example

Private Sub TextBox8_keyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If InStr("0123456789.", Chr(KeyAscii)) = 0 Then
    KeyAscii = 0
    End If
End Sub

Private Sub ButValide_Click()
   Cells(Nlig, 8).Value = Val(TextBox8.Value)
End Sub

A+

Maurice

Merci je vais essayer au bureau demain