virgüllü değeri yuvarlamayı engellemek

[sahir73]

Çalıştığım formda textbox ile kaydettiğim 2,75 gibi küsüratlı değer kaydedilirken yukarı yuvarlatılıyor. Haliyle değeri kullanmak istediğimde 2,8 gibi bir değer geliyor. kaydetmek istediğim değeri olduğu gibi yani 2.75 şeklinde nasıl kaydedebilirim

 

[Muzaffer Ali]

Merhaba.

Konu hakkındaki kodları da paylaşın ki nerede hata olduğunu bulalım.

 

[sahir73]

Merhaba.

Konu hakkındaki kodları da paylaşın ki nerede hata olduğunu bulalım.

Burası kayıt formu
Private Sub cbUcretlendirme_Change()

If cbUcretlendirme.ListIndex = 0 Then
txtUcret.Value = Format(Sheets("Ayarlar").Range("E2"), "#,##0.0")

txtUcret.Value = txtUcret.Value
ElseIf cbUcretlendirme.ListIndex = 1 Then
txtUcret.Value = Format(Sheets("Ayarlar").Range("E3"), "#,##0.0")
txtUcret.Value = txtUcret.Value
ElseIf cbUcretlendirme.ListIndex = 2 Then
txtUcret.Value = Format(Sheets("Ayarlar").Range("E4"), "#,##0.0")
txtUcret.Value = txtUcret.Value
ElseIf cbUcretlendirme.ListIndex = 3 Then
txtUcret.Value = Format(Sheets("Ayarlar").Range("E5"), "#,##0.0")
txtUcret.Value = txtUcret.Value
End If
End Sub





Private Sub txtSayfaSayisi_Change()
On Error Resume Next
Dim ucret As Double

Dim ss As Integer
Dim toplam As Double


If Not IsNumeric(txtSayfaSayisi.Value) Then txtSayfaSayisi.Value = "": txtSayfaSayisi.SetFocus
ucret = Format(txtUcret.Value, "#,##0.0")
ss = txtSayfaSayisi.Value
txtToplamTutar.Value = ucret * ss
Exit Sub
End Sub


Burası ücret giriş formu
Private Sub btnKaydet_Click()

Dim sor As Byte

'Kayıt edilmek istenen müşteri numrasının daha önce kayıt edilip edilmediğini sorguladık.

sor = MsgBox("Fax fiyat tarifesi güncellensin mi?", vbYesNo + vbDefaultButton1 + vbQuestion, "GÜNCELLE")
If sor = vbNo Then Exit Sub


Sheets("Ayarlar").Range("E2").Value = Format(CDbl(txtGidenFax.Value), "#,##0.0")
Sheets("Ayarlar").Range("E3").Value = Format(CDbl(txtGelenFax.Value), "#,##0.0")
Unload Me
frmMesaj.lblMesaj.Caption = "Fax fiyat tarifesi güncellendi."
frmMesaj.Show
End Sub

 

[sahir73]

İndir app

Dosyayı indir app

dosya.co

 

[sahir73]

Burası kayıt formu
Private Sub cbUcretlendirme_Change()

If cbUcretlendirme.ListIndex = 0 Then
txtUcret.Value = Format(Sheets("Ayarlar").Range("E2"), "#,##0.0")

txtUcret.Value = txtUcret.Value
ElseIf cbUcretlendirme.ListIndex = 1 Then
txtUcret.Value = Format(Sheets("Ayarlar").Range("E3"), "#,##0.0")
txtUcret.Value = txtUcret.Value
ElseIf cbUcretlendirme.ListIndex = 2 Then
txtUcret.Value = Format(Sheets("Ayarlar").Range("E4"), "#,##0.0")
txtUcret.Value = txtUcret.Value
ElseIf cbUcretlendirme.ListIndex = 3 Then
txtUcret.Value = Format(Sheets("Ayarlar").Range("E5"), "#,##0.0")
txtUcret.Value = txtUcret.Value
End If
End Sub





Private Sub txtSayfaSayisi_Change()
On Error Resume Next
Dim ucret As Double

Dim ss As Integer
Dim toplam As Double


If Not IsNumeric(txtSayfaSayisi.Value) Then txtSayfaSayisi.Value = "": txtSayfaSayisi.SetFocus
ucret = Format(txtUcret.Value, "#,##0.0")
ss = txtSayfaSayisi.Value
txtToplamTutar.Value = ucret * ss
Exit Sub
End Sub


Burası ücret giriş formu
Private Sub btnKaydet_Click()

Dim sor As Byte

'Kayıt edilmek istenen müşteri numrasının daha önce kayıt edilip edilmediğini sorguladık.

sor = MsgBox("Fax fiyat tarifesi güncellensin mi?", vbYesNo + vbDefaultButton1 + vbQuestion, "GÜNCELLE")
If sor = vbNo Then Exit Sub


Sheets("Ayarlar").Range("E2").Value = Format(CDbl(txtGidenFax.Value), "#,##0.0")
Sheets("Ayarlar").Range("E3").Value = Format(CDbl(txtGelenFax.Value), "#,##0.0")
Unload Me
frmMesaj.lblMesaj.Caption = "Fax fiyat tarifesi güncellendi."
frmMesaj.Show
End Sub

İndir app

Dosyayı indir app

dosya.co

 

[Korhan Ayhan]

Şu bölüme bir sıfır daha ekleyip deneyiniz.

"#,##0.00"

 

[Muzaffer Ali]

Merhaba. Dosyanızı inceledim. Çok fazla hata var hangi birini düzelteyim.
Korhan bey onun yerine şunu kullansa daha pratik olur diye düşünüyorum.
Format(Sheets("Ayarlar").Range("E5"), "#,##0.0")
gibi olan kodları aşağıdaki gibi yapın.
Formatnumber(Sheets("Ayarlar").Range("E5"), 2) 'Buradaki 2 virgülden sonra 2 hane olsun anlamına gelir.

Ayrıca "On Error Resume Next" Bu satırları silin. Bırakın kodlar eğer hata verecekse versin ki nerede hata olduğunu bulun ve çözüm arayın.

Diğer bir konu;
Dim DeğişkenAdı integer ' Bu değişken küsüratlı değildir.
Yani DeğişkenAdı=1,25 yazsanız bile 1 değerini alır.,
Küsüratlı değişken tanımlamak için Double değişkeni tanımlamalısınız.
Dim DeğişkenAdı Double gibi.

Bir kod kısaltması yapılabilir.
FrmFaxKAy formunda bulunan "Private Sub cbUcretlendirme_Change()" kodlarını silin aşağıdakini ekleyin.

Private Sub cbUcretlendirme_Change()
txtUcret.Value = FormatNumber(Sheets("Ayarlar").Cells(cbUcretlendirme.ListIndex + 2, "E"), 2)
End Sub

Başka hatalar var mı bilmiyorum, Çünkü dosyanızın tamamını inceleyemedim.

 

[sahir73]

Daha önce bu kadar yardımsever kişinin bulunduğu bir forma üye olmamıştım. Emeğinize elinize sağlık.