AccessTr.neT

Tam Versiyon: Verileri Değiştirmek
Şu anda arşiv modunu görüntülemektesiniz. Tam versiyonu görüntülemek için buraya tıklayınız.
Sayfalar: 1 2 3 4
Userform1deki Private Sub CommandButton13_Click()  alttaki yerleri çift yazmışsınız inceleyin orayı.

TextBox8.Text = ""
TextBox9.Text = ""
TextBox8.Text = ""
TextBox9.Text = ""
Hocam CommandButton13_Click()  silmiştim kodlarını silmeyi unutmuşum CommandButton13_Click()  diye bir buton yok. Koları sildim.
Şimdi toplanmayan yerler neresi ben bulamadım ve baktım sorun yok
Cdbl olarak istiyorsanız kodları kısaltmak adına döngü ile yaptım ve ayrıca textboxları temizlemeyide döngü ile yaptım.

Deneyiniz doğru sonuç verecek mi?

Dim arr
arr = Array("TextBox3", "TextBox4", "TextBox5", "TextBox7", "TextBox9", "TextBox11", "TextBox8")

For i = 3 To 10
    If Me.Controls(arr(i - 3)) = "" Then
        ActiveCell.Offset(0, i).Value.ClearContents
    Else
        ActiveCell.Offset(0, i).Value = CDbl(Me.Controls(arr(i - 3)))
    End If
Next

Yıkardaki kodu ekledim düğerlerini silip.


Private Sub CommandButton12_Click()
Dim say As Integer
If islemYapma = True Then Exit Sub

'If TextBox5.Value & TextBox6.Value & TextBox8.Value & TextBox85.Value & TextBox86.Value & TextBox88.Value = "" Then

ActiveSheet.Unprotect "4455"
var:
GIRIS = InputBoxDK("ÞÝFRE GÝRÝÞÝ.", "ÞÝFRE PENCERESÝ", "") ''InputBox a parola maskesi ba?y devacy modülde
sifre = "111" ' Þifrenizi buraya tanymlayynyz.
If GIRIS = "" Then
MsgBox "ÝÞLEM ÝPTAL EDÝLDÝ"
ActiveSheet.Protect "4455"
Exit Sub
End If
If GIRIS <> sifre Then
MsgBox "ÞÝFRE YANLIÞ"
say = say + 1
If say = 5 Then Exit Sub
GoTo var
Exit Sub
End If
MsgBox "KAYITLAR DEÐÝÞTÝRÝLMÝÞTÝR." 'InputBox a parola maskesi sonu
satýr = ActiveCell.Row
ListBox1.RowSource = ""
On Error Resume Next
ActiveSheet.Unprotect "4455"


ActiveCell.Offset(0, 1).Value = CDate(TextBox1.Value)
ActiveCell.Offset(0, 2).Value = TextBox2

Dim i As Byte
Dim arr
arr = Array("TextBox3", "TextBox4", "TextBox5", "TextBox7", "TextBox9", "TextBox11", "TextBox8")

For i = 3 To 10
    If Me.Controls(arr(i - 3)) = "" Then
        ActiveCell.Offset(0, i).clearcontents

    Else
        ActiveCell.Offset(0, i).Value = CDbl(Me.Controls(arr(i - 3)))
    End If
Next

On Error GoTo 0
ActiveSheet.PageSetup.PrintArea = "$A$1:$K$" & [A65536].End(3).Row
Range("A65535").End(xlUp).Offset(1, 0).Select
ThisWorkbook.Save
TextBox1.SetFocus
'Unload Me
'UserForm1.Show
'Exit For
'End If

For i = 2 To 11
    Me.Controls("TextBox" & i) = Empty
Next
Me.ComboBox3 = Empty

' toplamlar Makro sonu
ActiveSheet.Protect "4455"
CommandButton2_Click
TextBox8.Text = [L4]
TextBox9.Text = [L6]
TextBox1.Text = [L7]
TextBox28.Text = [M1]
UserForm_Initialize
ListBox1.ListIndex = ListBox1.ListCount - 1 'ListBoxýn son satýrýna gider.'
Range("A65535").End(xlUp).Offset(1, 0).Select 'Son boþ satýra gider
TextBox1.Text = CDate(Date) 'Form Açýlýþta otomatik tarih

'Else
'MsgBox "...!!!.LÜTFEN PERSONEL ÖDEMELERÝ VEYA TEDARÝKÇÝLER ÝLE BÝLGÝLERÝ GÝRÝNÝZ, MESAÝ BÝLGÝLERÝNÝ GÝRMEYÝNÝZ.!!!...", vbInformation
'End If
End Sub

Hocam TextBoxlardan değiştirilip exel sayfasına aktarılan miktarları toplama alınmayan hücreleri yukarıdaki toplama hücreleri ile ayni renk dolgu olarak gösterdim.
Hocam Cdbl olması şart değil yeterki doğru sonuç versin 
Hocam eklediğiniz kod resimdeki hatayı veriyor.

[Resim: do.php?img=10214]
Sayfalar: 1 2 3 4