Excel Forum
ALTIN ÜYELİK Hakkında Bilgi


Geri Git   Excel Forum > EXCEL-Soruları > Makro-VBA
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ / REKLAM PANOSU

Makro-VBA Makro veya VBA ile ilgili sorularınızı buraya gönderebilirsiniz.
Dosya ekleyebilirsiniz

Özel Arama


Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 08-02-2012, 15:01   #1
Lanvin
 
Giriş: 10/04/2008
Şehir: İSTANBUL
Mesaj: 42
Excel Vers. ve Dili:
EXCEL 2007 / TR
Question Teknik Servis Arıza Kayıt Programı

Merhaba,

Sitede bazı arkadaşların oluşturduğu program üzerinde bir çok geliştirmeler yaptım.
Lakin 1 tek yapmak istediğim bir şey var. Yapamıyorum.
Konuya daha vakıf bir arkadaş el atarsa sevinirim.



Uploaded with ImageShack.us

Ekranda gördüğünüz gibi arızalı cihaz kayıtlarından bir satırı seçip düzenle dediğimizde üstte yer alan girdi ekranına taşıyacak ve düzenlemeye izin verecek. Kaydet dediğimizde de yine aynı satıra kaydedecek.

Kısacası yapılan işleme göre satırı güncellemek istiyorum.

Şimdiden teşekkürler.
Eklenmiş Dosyalar
Dosya Türü: rar TEKNİK SERVİS ARIZA KAYIT PROGRAMI.rar (63.5 KB, 721 Görüntülenme)
Lanvin Çevrimdışı   Alıntı Yaparak Cevapla
Eski 08-02-2012, 17:12   #2
Husgvarna
 
Giriş: 31/01/2010
Şehir: Gürün
Mesaj: 553
Excel Vers. ve Dili:
Excel 2003
Varsayılan

Userformun kod sayfasında ki "Private Sub ListBox1_Click()" kodlarını kaldırıp:

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
 Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
For a = 0 To 8
Controls("TextBox" & a + 1) = ListBox1.List(ListBox1.ListIndex, a)
Next
End Sub
Kodlarını ekleyin. Listeye çift tıkladığınızda verileri "Textbox"lara alır.



"Düzenle" adlı butonunu "Yenile" veya "Güncelle" olarak değiştirip:
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Private Sub CommandButton6_Click()
       For a = 1 To 9
        Sheets("DATA").Cells(ListBox1.ListIndex + 2, a) = Controls("TextBox" & a).Text
Next
        Sheets("DATA").Cells(ListBox1.ListIndex + 2, 10) = Environ("username") & " - " & Format(Now, "dd.mm.yyyy hh.mm.ss")
    ActiveWorkbook.Save
   MsgBox "Günceleme Tamam", vbInformation, "Necron A.Ş."
ListBox1.ColumnCount = 10 ' lisbox'ta ki sütun sayısı
ListBox1.ColumnWidths = "110;80;70;70;60;60;100;120;70;70" 'lisbox'taki sütunların genişliği
ListBox1.RowSource = "DATA!A2:J" & Sheets("DATA").Range("A65536").End(xlUp).Row 'lisbox'ta gösterilecek hücre aralığı
ListBox1.ColumnHeads = True 'listboxta birinci satırı sabitler tıklanmaz
End Sub
Kodlarını ekleyin.

"Kaydet" adlı butondaki kodları ellemeyin. Yeni kayıtlarda kullanın.
Husgvarna Çevrimdışı   Alıntı Yaparak Cevapla
Eski 08-02-2012, 18:29   #3
Lanvin
 
Giriş: 10/04/2008
Şehir: İSTANBUL
Mesaj: 42
Excel Vers. ve Dili:
EXCEL 2007 / TR
Varsayılan

Alıntı:
Husgvarna tarafından gönderildi Mesajı Görüntüle
Userformun kod sayfasında ki "Private Sub ListBox1_Click()" kodlarını kaldırıp:

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
 Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
For a = 0 To 8
Controls("TextBox" & a + 1) = ListBox1.List(ListBox1.ListIndex, a)
Next
End Sub
Kodlarını ekleyin. Listeye çift tıkladığınızda verileri "Textbox"lara alır.



"Düzenle" adlı butonunu "Yenile" veya "Güncelle" olarak değiştirip:
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Private Sub CommandButton6_Click()
       For a = 1 To 9
        Sheets("DATA").Cells(ListBox1.ListIndex + 2, a) = Controls("TextBox" & a).Text
Next
        Sheets("DATA").Cells(ListBox1.ListIndex + 2, 10) = Environ("username") & " - " & Format(Now, "dd.mm.yyyy hh.mm.ss")
    ActiveWorkbook.Save
   MsgBox "Günceleme Tamam", vbInformation, "Necron A.Ş."
ListBox1.ColumnCount = 10 ' lisbox'ta ki sütun sayısı
ListBox1.ColumnWidths = "110;80;70;70;60;60;100;120;70;70" 'lisbox'taki sütunların genişliği
ListBox1.RowSource = "DATA!A2:J" & Sheets("DATA").Range("A65536").End(xlUp).Row 'lisbox'ta gösterilecek hücre aralığı
ListBox1.ColumnHeads = True 'listboxta birinci satırı sabitler tıklanmaz
End Sub
Kodlarını ekleyin.

"Kaydet" adlı butondaki kodları ellemeyin. Yeni kayıtlarda kullanın.
Abi Selam,

Aynen dediğin gibi yaptım.
Çift tıklayınca yukarı alıyor güncelle dediğinde güncelliyor.
Buraya kadar mükemmel, lakin herhangi bir satırı seçip, SİL dediğimizde hep 3. satır sabit ordan siliyor. Seçtiğimiz satırı silmiyor.

Bir bakarmısın..

Teşekkürler.

Son hali eklidir.
Eklenmiş Dosyalar
Dosya Türü: xls TEKNİK SERVİS ARIZA KAYIT PROGRAMI.xls (126.0 KB, 233 Görüntülenme)
Lanvin Çevrimdışı   Alıntı Yaparak Cevapla
Eski 08-02-2012, 19:31   #4
Husgvarna
 
Giriş: 31/01/2010
Şehir: Gürün
Mesaj: 553
Excel Vers. ve Dili:
Excel 2003
Varsayılan

Alıntı:
Lanvin tarafından gönderildi Mesajı Görüntüle
Aynen dediğin gibi yaptım.
Çift tıklayınca yukarı alıyor güncelle dediğinde güncelliyor.
Buraya kadar mükemmel, lakin herhangi bir satırı seçip, SİL dediğimizde hep 3. satır sabit ordan siliyor. Seçtiğimiz satırı silmiyor.
Bir bakarmısın..
Son hali eklidir.
"SİL" butonundaki kodları aşağıdaki değiştirip; iyi kontrol ettikden sonra kullanın.
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
 Private Sub CommandButton2_Click()
R = MsgBox("Seçili Kayıt Sistemden Silinecek Devam mı?", vbYesNo)
If R = vbYes Then
Sheets("DATA").Range("a" & ListBox1.ListIndex + 2 & ":j" & ListBox1.ListIndex + 2).Delete Shift:=xlUp
If Sheets("DATA").Cells(Sheets("DATA").Cells(65000, 1).End(xlUp).Row, 2) = "" Then _
Cells(Sheets("DATA").Cells(65000, 1).End(xlUp).Row, 1) = ""
MsgBox "Kayıt Silinmiştir...!", Title:="Necron A.Ş."
Else
MsgBox "Malzeme Kaydı Silme İşlemi İptal Edilmiştir.", vbInformation, "Necron A.Ş."
End If
End Sub
Husgvarna Çevrimdışı   Alıntı Yaparak Cevapla
Eski 09-02-2012, 09:55   #5
Lanvin
 
Giriş: 10/04/2008
Şehir: İSTANBUL
Mesaj: 42
Excel Vers. ve Dili:
EXCEL 2007 / TR
Question

Alıntı:
Husgvarna tarafından gönderildi Mesajı Görüntüle
"SİL" butonundaki kodları aşağıdaki değiştirip; iyi kontrol ettikden sonra kullanın.
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
 Private Sub CommandButton2_Click()
R = MsgBox("Seçili Kayıt Sistemden Silinecek Devam mı?", vbYesNo)
If R = vbYes Then
Sheets("DATA").Range("a" & ListBox1.ListIndex + 2 & ":j" & ListBox1.ListIndex + 2).Delete Shift:=xlUp
If Sheets("DATA").Cells(Sheets("DATA").Cells(65000, 1).End(xlUp).Row, 2) = "" Then _
Cells(Sheets("DATA").Cells(65000, 1).End(xlUp).Row, 1) = ""
MsgBox "Kayıt Silinmiştir...!", Title:="Necron A.Ş."
Else
MsgBox "Malzeme Kaydı Silme İşlemi İptal Edilmiştir.", vbInformation, "Necron A.Ş."
End If
End Sub
Merhaba,

Aynen dediklerinizi yaptım, mükemmel oldu.
Tabi kullana kullana açıkları farkediyoruz.
Mesela yeni saptadığım bir sıkıntı şöyle.
Giriş veya çıkış tarihine göre sırala dediğimizde hatalı dizilim yapıyor.

Örneğin sırala dediğimiz vakit şöyle diziyor.
01.01.2012
08.01.2012
08.02.2012
09.01.2012
09.02.2012
10.01.2012
14.01.2012

Analayacağınız gibi rakam rakam değerlendiriyor. Yani güne göre dizmiş gibi oluyor. Aynı olan satırlar harf harf bakıp ilk farklı harfte bir alta atıyor. Bu da 09.02 ve 10.01 tarihine geçişte önümüze gelmiş oluyor.

Yardımcı olursanız çok memnun olurum.

Herşey için teşekkürler.
Lanvin Çevrimdışı   Alıntı Yaparak Cevapla
Eski 09-02-2012, 11:35   #6
Husgvarna
 
Giriş: 31/01/2010
Şehir: Gürün
Mesaj: 553
Excel Vers. ve Dili:
Excel 2003
Varsayılan

Alıntı:
Lanvin tarafından gönderildi Mesajı Görüntüle

Analayacağınız gibi rakam rakam değerlendiriyor. Yani güne göre dizmiş gibi oluyor. Aynı olan satırlar harf harf bakıp ilk farklı harfte bir alta atıyor. Bu da 09.02 ve 10.01 tarihine geçişte önümüze gelmiş oluyor.

Yardımcı olursanız çok memnun olurum.
Merhaba.
Sıralama kodunda bir hata yok.
Hata giriş yapan kodları değiştirmek gerekiyor. Varsa tarihleri yenilemeniz gerekli.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
 Private Sub CommandButton1_Click()
Dim satır
With Sheets("DATA")
        satır = Range("A65536").End(3).Row + 1
        Cells(satır, 1) = TextBox1.Text
        Cells(satır, 2) = TextBox2.Text
        Cells(satır, 3) = CDate(TextBox3.Text)
        Cells(satır, 4) = CDate(TextBox4.Text)
       '.................................
       '.................................
        '.................................
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
  Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
For a = 0 To 8
If a = 2 Then
Controls("TextBox" & a + 1) = Format(ListBox1.List(ListBox1.ListIndex, a), "dd.mm.yyyy")
a = a + 1
Controls("TextBox" & a + 1) = Format(ListBox1.List(ListBox1.ListIndex, a), "dd.mm.yyyy")
a = a + 1
End If
Controls("TextBox" & a + 1) = ListBox1.List(ListBox1.ListIndex, a)
Next
End Sub
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
 Private Sub CommandButton6_Click()
       For a = 1 To 9
       If a = 3 Then
       Sheets("DATA").Cells(ListBox1.ListIndex + 2, a) = CDate(Controls("TextBox" & a).Text)
       a = a + 1
       Sheets("DATA").Cells(ListBox1.ListIndex + 2, a) = CDate(Controls("TextBox" & a).Text)
       a = a + 1
       End If
        Sheets("DATA").Cells(ListBox1.ListIndex + 2, a) = Controls("TextBox" & a).Text
Next
        Sheets("DATA").Cells(ListBox1.ListIndex + 2, 10) = Environ("username") & " - " & Format(Now, "dd.mm.yyyy hh.mm.ss")
    ActiveWorkbook.Save
   MsgBox "Günceleme Tamam", vbInformation, "Necron A.Ş."
ListBox1.ColumnCount = 10 ' lisbox'ta ki sütun sayısı
ListBox1.ColumnWidths = "110;80;70;70;60;60;100;120;70;70" 'lisbox'taki sütunların genişliği
ListBox1.RowSource = "DATA!A2:J" & Sheets("DATA").Range("A65536").End(xlUp).Row 'lisbox'ta gösterilecek hücre aralığı
ListBox1.ColumnHeads = True 'listboxta birinci satırı sabitler tıklanmaz
End Sub
Husgvarna Çevrimdışı   Alıntı Yaparak Cevapla
Eski 09-02-2012, 12:40   #7
Lanvin
 
Giriş: 10/04/2008
Şehir: İSTANBUL
Mesaj: 42
Excel Vers. ve Dili:
EXCEL 2007 / TR
Varsayılan

Alıntı:
Husgvarna tarafından gönderildi Mesajı Görüntüle
Merhaba.
Sıralama kodunda bir hata yok.
Hata giriş yapan kodları değiştirmek gerekiyor. Varsa tarihleri yenilemeniz gerekli.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
 Private Sub CommandButton1_Click()
Dim satır
With Sheets("DATA")
        satır = Range("A65536").End(3).Row + 1
        Cells(satır, 1) = TextBox1.Text
        Cells(satır, 2) = TextBox2.Text
        Cells(satır, 3) = CDate(TextBox3.Text)
        Cells(satır, 4) = CDate(TextBox4.Text)
       '.................................
       '.................................
        '.................................
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
  Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
For a = 0 To 8
If a = 2 Then
Controls("TextBox" & a + 1) = Format(ListBox1.List(ListBox1.ListIndex, a), "dd.mm.yyyy")
a = a + 1
Controls("TextBox" & a + 1) = Format(ListBox1.List(ListBox1.ListIndex, a), "dd.mm.yyyy")
a = a + 1
End If
Controls("TextBox" & a + 1) = ListBox1.List(ListBox1.ListIndex, a)
Next
End Sub
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
 Private Sub CommandButton6_Click()
       For a = 1 To 9
       If a = 3 Then
       Sheets("DATA").Cells(ListBox1.ListIndex + 2, a) = CDate(Controls("TextBox" & a).Text)
       a = a + 1
       Sheets("DATA").Cells(ListBox1.ListIndex + 2, a) = CDate(Controls("TextBox" & a).Text)
       a = a + 1
       End If
        Sheets("DATA").Cells(ListBox1.ListIndex + 2, a) = Controls("TextBox" & a).Text
Next
        Sheets("DATA").Cells(ListBox1.ListIndex + 2, 10) = Environ("username") & " - " & Format(Now, "dd.mm.yyyy hh.mm.ss")
    ActiveWorkbook.Save
   MsgBox "Günceleme Tamam", vbInformation, "Necron A.Ş."
ListBox1.ColumnCount = 10 ' lisbox'ta ki sütun sayısı
ListBox1.ColumnWidths = "110;80;70;70;60;60;100;120;70;70" 'lisbox'taki sütunların genişliği
ListBox1.RowSource = "DATA!A2:J" & Sheets("DATA").Range("A65536").End(xlUp).Row 'lisbox'ta gösterilecek hücre aralığı
ListBox1.ColumnHeads = True 'listboxta birinci satırı sabitler tıklanmaz
End Sub
SİL işleminde hata verdi.

Cells(satır, 4) = CDate(TextBox4.Text)

satırını gösteriyor.
Lanvin Çevrimdışı   Alıntı Yaparak Cevapla
Eski 09-02-2012, 14:37   #8
Husgvarna
 
Giriş: 31/01/2010
Şehir: Gürün
Mesaj: 553
Excel Vers. ve Dili:
Excel 2003
Varsayılan

Alıntı:
Lanvin tarafından gönderildi Mesajı Görüntüle
SİL işleminde hata verdi.

Cells(satır, 4) = CDate(TextBox4.Text)

satırını gösteriyor.
"TextBox4" boş kalmış veya tarih harici veri girilmiş olabilir.

Ekte 3 butonun ve listbox un kodlarına eklemeler yapmaya çalıştım
dosyanızdaki ilgili kodları bunlarla değiştirip deneyin.
Eklenmiş Dosyalar
Dosya Türü: zip Yeni Metin.zip (1.2 KB, 125 Görüntülenme)
Husgvarna Çevrimdışı   Alıntı Yaparak Cevapla
Eski 09-02-2012, 15:36   #9
Lanvin
 
Giriş: 10/04/2008
Şehir: İSTANBUL
Mesaj: 42
Excel Vers. ve Dili:
EXCEL 2007 / TR
Thumbs up

Alıntı:
Husgvarna tarafından gönderildi Mesajı Görüntüle
"TextBox4" boş kalmış veya tarih harici veri girilmiş olabilir.

Ekte 3 butonun ve listbox un kodlarına eklemeler yapmaya çalıştım
dosyanızdaki ilgili kodları bunlarla değiştirip deneyin.
İşlem tamam abi değişiklikleri yaptım.
Saat gibi çalışıyor.

Emeğine bilgine sağlık.

Güzel program oldu.

Son haliyle herkes kullanabilir.

Açık Kaynak Şifre koymuyorum.

Paylaşılmayan bilgi, mum alevine benzer..

PROGRAMIN SON HALİ EKTEDİR.
Eklenmiş Dosyalar
Dosya Türü: xls TEKNİK SERVİS ARIZA KAYIT PROGRAMI.xls (107.5 KB, 557 Görüntülenme)
Lanvin Çevrimdışı   Alıntı Yaparak Cevapla
Eski 10-02-2012, 22:51   #10
Husgvarna
 
Giriş: 31/01/2010
Şehir: Gürün
Mesaj: 553
Excel Vers. ve Dili:
Excel 2003
Varsayılan

Alıntı:
Lanvin tarafından gönderildi Mesajı Görüntüle
İşlem tamam abi değişiklikleri yaptım.
Saat gibi çalışıyor.
Paylaşılmayan bilgi, mum alevine benzer..
PROGRAMIN SON HALİ EKTEDİR.
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
  Private Sub CommandButton2_Click()
If ListBox1.ListIndex = -1 Then Exit Sub
R = MsgBox("Seçili Kayıt Sistemden Silinecek Devam mı?", vbYesNo)
If R = vbYes Then
If ListBox1.ListIndex = False Then MsgBox "Güncellenecek veri bulunamadı"
Kırmızı bölümü silin.

Bu mesaj en son " 11-02-2012 " tarihinde saat 08:43 itibariyle Husgvarna tarafından düzenlenmiştir....
Husgvarna Çevrimdışı   Alıntı Yaparak Cevapla
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 18:48


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Web Tasarım -- Beylikdüzü mali müşavir - Lingerie - Dyeing Machine - Karton Bardak- Çorlu Özel Eğitim- Site Yönetimi- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Kırklareli- Pronet Çerkezköy- Pronet Çorlu- Pronet Lüleburgaz- Pronet Keşan- Çorlu Araç Takip- Çorlu Su Arıtma- Gebze Emlak- Bakır Sülfat- Rampa- Rotary- Çorlu İnternet Sitesi- youngblood- Çorlu Sürücü Kursu- Çorlu Sandviç Panel- Şişli Avukat- Korona Test Kalemi- Çorlu Vinç- Çorlu Pimapen Tamiri- Çorlu Çelik Konstruksiyon- Çorlu Dans- Edirne Serbest Muhasebeci- Çorlu Etüt- İstanbul Botanik- Çorlu Sigorta-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden