• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Aynı kodla Değiştir işleminin zorluğu

A

Altay3555

Katılım
13 Haziran 2009
Mesajlar
486
Excel Vers. ve Dili
excel 2007 tr
Private Sub CommandButton2_Click()
'değiştir**************************************************
If ListBox1 = Empty Then
MsgBox "Veri yok.", vbExclamation, "Dikkat"
Exit Sub

End If
If ListBox1.ListIndex < 0 Then
MsgBox "Lütfen listeden seçiniz.", vbExclamation, "Dikkat"
Exit Sub

End If
If MsgBox("Kayıt Değiştirilecektir?", vbCritical + vbYesNo, "Dikkat") = vbYes Then
'ListBox1.RowSource = Empty

Cells(ActiveCell.Row, "B") = TextBox1
Cells(ActiveCell.Row, "C") = TextBox2
Cells(ActiveCell.Row, "D") = TextBox8
Cells(ActiveCell.Row, "E") = TextBox9
Cells(ActiveCell.Row, "F") = TextBox10
..............(Bu arada çok daha fazla txtb var.
Cells(ActiveCell.Row, "DU") = TextBox120
Cells(ActiveCell.Row, "DV") = TextBox121
Cells(ActiveCell.Row, "DW") = TextBox122


With Form_Giris.ListBox1
.ColumnCount = 135
.ColumnWidths = "0;35;50;20;20;20;0;0;0;30;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;20;20;20;0;0;0;30;0;0;0;0;20;20;20;0;0;0;30;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;40;0;0;0;0;0;0;0;0;0;40;0;0;0;0;0;40;0;0;0;20;20;20;30;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;20;20;30;20;20;20;20;20;30;20;20;20;20;30;20;20;20;20;20;"
If Sheets("Veri").Range("A2") = Empty Then
.RowSource = Empty
End If
End With
MsgBox "Kayıt Düzeltilmiştir.", vbInformation, "İşlem İptali"
End If
End Sub



Bu kodla "değiştir"komutu kullanıyorum.Lakin değiştirdim demesine rağmen "Veri" sayfasına kayıt yapmıyor.
(Onlarca da örnek uyguladım ama.Bir yardımınız dokunabilir mi.Bir ip ucu.

http://www.excel.web.tr/f48/framelerde-sekme-syrasy-duzenleme-t104758.html
Bu linkte dosya mevcut,şu anda dosya mevcut olmadığı için yükleyemedim.
 
Son düzenleme:
Altay3555' Alıntı:
Private Sub CommandButton2_Click()
'değiştir**************************************************
If ListBox1 = Empty Then
MsgBox "Veri yok.", vbExclamation, "Dikkat"
Exit Sub

End If
If ListBox1.ListIndex < 0 Then
MsgBox "Lütfen listeden seçiniz.", vbExclamation, "Dikkat"
Exit Sub

End If
If MsgBox("Kayıt Değiştirilecektir?", vbCritical + vbYesNo, "Dikkat") = vbYes Then
'ListBox1.RowSource = Empty
Cells(ActiveCell.Row, "B") = TextBox1
Cells(ActiveCell.Row, "C") = TextBox2
Cells(ActiveCell.Row, "D") = TextBox8
Cells(ActiveCell.Row, "E") = TextBox9
Cells(ActiveCell.Row, "F") = TextBox10
..............(Bu arada çok daha fazla txtb var.
Cells(ActiveCell.Row, "DU") = TextBox120
Cells(ActiveCell.Row, "DV") = TextBox121
Cells(ActiveCell.Row, "DW") = TextBox122


With Form_Giris.ListBox1
.ColumnCount = 135
.ColumnWidths = "0;35;50;20;20;20;0;0;0;30;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;20;20;20;0;0;0;30;0;0;0;0;20;20;20;0;0;0;30;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;40;0;0;0;0;0;0;0;0;0;40;0;0;0;0;0;40;0;0;0;20;20;20;30;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;20;20;30;20;20;20;20;20;30;20;20;20;20;30;20;20;20;20;20;"
If Sheets("Veri").Range("A2") = Empty Then
.RowSource = Empty
End If
End With
MsgBox "Kayıt Düzeltilmiştir.", vbInformation, "İşlem İptali"
End If
End Sub



Bu kodla "değiştir"komutu kullanıyorum.Lakin değiştirdim demesine rağmen "Veri" sayfasına kayıt yapmıyor.
(Onlarca da örnek uyguladım ama.Bir yardımınız dokunabilir mi.Bir ip ucu.

http://www.excel.web.tr/f48/framelerde-sekme-syrasy-duzenleme-t104758.html
Bu linkte dosya mevcut,şu anda dosya mevcut olmadığı için yükleyemedim.
Genişletmek için tıkla ...

'ListBox1.RowSource = Empty
Bu Kodun Başında ki ' işaretini kaldır.
 
Kardeşim bir nebze düzeldi,
lakin a1 de otomatik sıra var ama o yeni kayıt olarak algılayıp boş bir yere kayıt yapıyor.
 
Private Sub CommandButton2_Click()

If ListBox1 = Empty Then
MsgBox "Veri kaydı bulunamamıştır.", vbExclamation, "Dikkat"
Exit Sub
End If

If TextBox1.Text = Empty Then
MsgBox "Lütfen Listeden Seçim Yapınız", vbExclamation, "Dikkat"
Exit Sub
End If

If ListBox1.ListIndex < 0 Then
MsgBox "Listeden bir seçim yapmalısınız", vbExclamation, "Dikkat"
Exit Sub
End If

If MsgBox("Seçtiğiniz kayıt üzerinde değişiklik yapılacaktır onaylıyor musunuz ?", vbCritical + vbYesNo, "Dikkat") = vbYes Then


ListBox1.RowSource = Empty


Cells(ActiveCell.Row, "B") = TextBox1
Cells(ActiveCell.Row, "C") = TextBox2
Cells(ActiveCell.Row, "D") = TextBox8
Cells(ActiveCell.Row, "E") = TextBox9
Cells(ActiveCell.Row, "F") = TextBox10
..............(Bu arada çok daha fazla txtb var.
Cells(ActiveCell.Row, "DU") = TextBox120
Cells(ActiveCell.Row, "DV") = TextBox121
Cells(ActiveCell.Row, "DW") = TextBox122

With Form_Giris.ListBox1
.ColumnCount = 135
.ColumnWidths = "0;35;50;20;20;20;0;0;0;30;0;0;0;0;0;0;0;0;0;0;0;0 ;0;0;0;0;0;0;0;0;20;20;20;0;0;0;30;0;0;0;0;20;20;2 0;0;0;0;30;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;40;0;0; 0;0;0;0;0;0;0;40;0;0;0;0;0;40;0;0;0;20;20;20;30;0; 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;20;20;30;20; 20;20;20;20;30;20;20;20;20;30;20;20;20;20;20;"
If Sheets("Veri").Range("A2") = Empty Then
.RowSource = Empty
End If
End With
MsgBox "Kayıt Düzeltilmiştir.", vbInformation, "İşlem İptali"
End If
End Sub


"----------------------

Bu Kodu denermisin
 
Selam
Denedim ama pek olmadı galiba.Sıra numarasından kaynaklanan bir sorundan mı kaynaklanıyor bilemiyorum.Değişiklikleri yeni kayıt olarak algılıyor,sayfaya kaydediyor,listboxtan kayboluyor.
4 gündür uğraşıyorum ama artık yardım alma vakti geldi diye akşam yayınlamıştım.Orjinal dosyayı da ekliyorum şimdi.
Şimdiden Teşekkürler.


Selamlar.Yeni dosyayı ham hali ile ekledim.Aslında uzun kodlarla yazmanın daha kolay ve izlenebilir olduğunu düşünüyordum ama olmadı.
Ekte yeni dosyaya Kaydet,Değiştir kodlarının kısa halinin nasıl olacağını merak ederek ekledim.Ben denedim ama çalışmadı.
 

Ekli dosyalar

Son düzenleme:
Altay3555' Alıntı:
Selam
Denedim ama pek olmadı galiba.Sıra numarasından kaynaklanan bir sorundan mı kaynaklanıyor bilemiyorum.Değişiklikleri yeni kayıt olarak algılıyor,sayfaya kaydediyor,listboxtan kayboluyor.
4 gündür uğraşıyorum ama artık yardım alma vakti geldi diye akşam yayınlamıştım.Orjinal dosyayı da ekliyorum şimdi.
Şimdiden Teşekkürler.
Genişletmek için tıkla ...

Öneri!

Textbox nesnelerini ardışık sayfanın sutün numaralarıyla aynı yapsaydın kodlar bu kadar büyük olmazdı

örnek olarak ListBox1_DblClick makrosu aşağıdaki gibi kısacık olurdu ve kodlara hakim olurdunuz.



Kod: 
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
For i = 1 To 174
Controls("TextBox" & i).Text = ListBox1.List(ListBox1.ListIndex, i)
Next i
End Sub

yada kayıt et makronuz bu kadar kısa olurdu.

Kod: 
Private Sub CommandButton1_Click() 'AŞI FORMU KAYDET
If TextBox1.Text = Empty Then MsgBox "YIL Giriniz.", , "İhsan T": Exit Sub
If TextBox2.Text = Empty Then MsgBox "AY Giriniz.", , "İhsan T": Exit Sub
If TextBox3.Text = Empty Then MsgBox "ASM Adı Giriniz", , "İhsan T": Exit Sub
If TextBox4.Text = Empty Then MsgBox "BİRİM KODU Giriniz", , "İhsan T": Exit Sub
If TextBox5.Text = Empty Then MsgBox "DOKTOR Adı Giriniz", , "İhsan T": Exit Sub
If TextBox6.Text = Empty Then MsgBox "BU AYIN NÜFUSUNU Giriniz", , "İhsan T": Exit Sub
If TextBox7.Text = Empty Then MsgBox "BEBEK Sayısı Giriniz", , "İhsan T": Exit Sub
cevap = MsgBox("Kayıt Etmek İstediğinizden Eminmisiniz!", vbYesNo, "İhsan T")
If cevap = vbNo Then Exit Sub
Son_Dolu_Satir = Sheets("Veri").Range("A65536").End(xlUp).Row
Bos_Satir = Son_Dolu_Satir + 1
Sheets("Veri").Range("A" & Bos_Satir).Value = _
Application.WorksheetFunction.Max(Sheets("Veri").Range("A:A")) + 1
For i = 1 To 174
Sheets("Veri").Cells(Bos_Satir, i).Value = Controls("TextBox" & i).Text
Next i
MsgBox "Kayıt Yapıldı"
Sheets("Veri").Select
ActiveWorkbook.Save
End Sub
 
Altay3555' Alıntı:
Dosyayı yeniledim,ama kodu uygulayamadım.
Genişletmek için tıkla ...

Örnek olması amacı ile

1-sayfanda 174 kolan var siz döngüleri 184 olarak yapmışsınız.
2-textbox nesnelerinden 37-173-174 nolu text nesneleri yok bu yöntemle textbox nesneleri ardışık ve userform üzerinde olmalı
3- dörtten başlıyarak sekize kadar olan sutünların kaydırarak ben yerlerini değitirdim.çünkü textbox nesnelerinini ardışık olması için
4-dosyanız tasarım aşamasındayken userformdaki nesnelerin renklerini görünen renklerden yapınki hata olursa kontrol etmek kolay olur.
5-sutunların kayması ile bazı toplama yapan textboxları kontrol edin.

dosyanızı kontrol edin.
 

Ekli dosyalar

Hocam Selam,
Dediğinizi şekilde tüm textboxları yeniden düzenleyeceğim,kodları da yerleştirdikten sonra eğer eksik birşey kalırsa yardımlarınızı talep edeceğim.
Hoşça ve Sağlıcakla Kalın
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst