Matbu dilekçe hazırlama programında 4 sorun

[cems]

Zipten çıkarılan klasörün C:\ Altına konması , yani yolun "C:|resimler" olması gerekli . Burada programın kısayolu yapılarak masaustune çekilmeli


Bir üyenin talebini ,userform kontrolleri ile geliştirdim.
Özetle; diplomasını kaybeden ve tasdiknamesini kurumdan almak isteyenler için bir matbu dilekçe düzenlemek amaçlı, kişi listesi ve belge sayfası var. Ancak listede herkesin (asıl liste 1970lere gittiğinden ) TC kimliği yok ve iki taraflı kontrol edilerek önce TC sinn yerleştirilmesi ve buradan da belge sayfasına gerekli hücrelerin aktarımını yapmak üzere 14 textbox 1 listbox 2 combobox ile resim çağırmak üzere bir imagebox nesneleri olan bir userform yaptım.

Dosyanın masaustunde kazara delete edilmesi riskine karşılık, dosya ve resimleri içeren bir klasörü C: altına atarak dosyanın kısayolunu masaustune aldım. Buraya kadar sorun yok.

Ancak düzeltmeleri forumdaki örneklerle de eşleştirsem de gün boyu başaramadığım birkaç noktada sizlerin düzeltmesini rica etmek üzere, bütün klasörü zip olarak yüklüyorum. Kişi resmi bir kurumda ve mesaisine yetiştirmeyi umuyorum .

Aksaklıklar:
1- İkiz isim kontrolü yapmak için listboxu süzmesini beklediğim textbox41, isim yazarken tetiklendiğinde listbox un .Clear fonksiyonunda takılıyor. Süzme gerçekleşmiyor , dolayısı ile kişinin diğer ( ana baba adı doğum yeri vs ) ayrıntıları gözle kontrol edilip doğru olanı seçilemiyor. Bu seçme yapılır ve tıklanırsa veri textboxlara yükleniyor ve bu anda eksik olan TC Numarası girilip, değiştir tuşu ile de sabitleniyor.
Bundan sonra arama TC üzerinden yapılabilecek ve bulunduğunda Dilekçe tuşuna basıldığında veriden gelen bilgilerin Belge sayfasında gerekli yerlere (varsa resimle beraber ) aktarması gerçekleşecek.

2-Dilekçe tuşuna basınca userform kapanıyor ve Belge sayfasına aktarma yapılıyor. Burada sorun , eğer klasöre kondu ise userformda görünen resim Belge sayfasında ayrılan yer boyutunda değil minicik çıkıyor. Bunun yerine tam ( AD31) eşitlenmesi gerekiyor.

3- Belge sayfasında aslında printpreview ve userforma dön tuşları var. Ancak kodlarda bulunan Alldrawingobjects.delete , eski resimle beraber bu tuşları da yok ediyor. Dolayısı ile altta sayfa adlarına basarak geri dönmek mümkün oluyor. Yani , belge sayfasında resmin boyutlanması ve baskı alanı dışında varolan 2 tuşun eski resimle beraber silinmekden kurtulması gerek.

4- TC kimlikten seçilen kişinin resmi varsa dilekçe tuşuna basınca belge sayfasına ( minik de olsa bir ) resim olarak atıyor. Kişinin resmi yoksa uyarı veriyor ancak , kodlar resim bulamadığında takılıp VBA yı açıyor. Resim yoksa Belge sayfasındaki (AD31) alan boş / beyaz olarak kalması gerek. Sayfada aslında printpreview ve userform aç kodları var ama tuşlar eski resimi kaldırırken (AllDrawingobjects.delete) ile temizlik esnasında siliniyor.

Bu aksaklıkların düzelmesi ve programın sorunsuz iş görmesi adına desteğiniz ve farklı kod uyarlamaları sevindirici olacaktır.

 

[halit3]

Private Sub TextBox41_Change() kodunu aşağıdaki ile değiştir.

Private Sub TextBox41_Change()
Dim sat, s As Integer
Dim deg1, deg2 As String
ListBox1.RowSource = ""
ReDim myarr(0 To 13, 1 To 1)
For sat = 5 To Cells(65536, "b").End(xlUp).Row
deg1 = UCase(Replace(Replace(Cells(sat, "b"), "ı", "I"), "i", "İ"))
deg2 = UCase(Replace(Replace(TextBox41, "ı", "I"), "i", "İ"))
If deg1 Like "*" & deg2 & "*" Then
a = a + 1
ReDim Preserve myarr(0 To 13, 1 To a)
For j = 0 To 13
myarr(j, a) = Cells(sat, j + 1)
Next j

End If: Next

ListBox1.Column = myarr
End Sub

Private Sub CommandButton3_Click() kodunu aşağıdaki ile değiştir.

Private Sub CommandButton3_Click()
If ActiveCell.Row < 2 Then
        MsgBox "İlk önce BUL ile değiştirmek istediğiniz veriyi bulmalısınız!", vbCritical
        Exit Sub
    End If
    
    Onay = MsgBox("Seçtiğiniz kayıt değiştirilecektir! Onaylıyor musunuz?", vbExclamation + vbYesNo)
    If Onay = vbNo Then Exit Sub
    
    'ActiveCell = Val(TextBox2)
    sat = Val(TextBox1.Value) + 4
    For i = 1 To 14
    Sheets("sayfa1").Cells(sat, i).Value = Me.Controls("TextBox" & i)
    Next i
    End Sub

Private Sub ComboBox2_Change() kodunu aşağıdaki ile değiştir.

Private Sub ComboBox2_Change()
Dim Hedef, resimadi, Dosya, uzanti

Hedef = ThisWorkbook.Path & "\"

resimadi = ComboBox2.Text
uzanti = ".jpg"

Dosya = Hedef & resimadi & uzanti
MsgBox Dosya
If CreateObject("Scripting.FileSystemObject").FileExists(Dosya) = True Then
UserForm1.Image1.Picture = LoadPicture(Dosya)
Call CommandButton8_Click
Else
Dosya = Hedef & "\yok.jpg"
UserForm1.Image1.Picture = LoadPicture(Dosya)
MsgBox "ŞAHSA AİT RESİM YOK. Lütfen BUL tuşu ile veriyi alınız."
End If


End Sub

 

[cems]

Sayın Halit3

Her 3 kodu da gerekli yerlere aktardım ,denemeler yapıyorum . İlk anda hiç bir sorun görünmedi, ikiz isimlerde doğru kişinin benzersiz textboxlara aktarılması için sol sıra numarasını temel alan bir 3cü combobox da ekledim ve kodlarınızı örnekledim. Bunu ,ikiz isim taraması hatalı satırı textboxlara getirirse benzersiz satır nosuna bakılarak doğrusunun çekilebilmesi için yaptım.

Küçük bir problem olarak ; ikiz isim tarattığımda gelen isimlere tıkladığımda o satırın değil başka satırın verisinin textboxlara aktarıldığını farkettim. Düzeltmeyi denedim ancak size sormanın daha doğru olduğunu düşündüm. Bu satır sıçramasını nasıl düzeltebilirim ?

Programın bütün olasılıkları cevaplayabildiğini sınamak için küçük değişiklikler ve liste çoğaltması yaptım , ileri saatlerde ağır denemelerin sonucunu da bildireceğim.

Bu ana dek göstermiş olduğunuz ilgi ve yardım için çok teşekkür ederim , büyük kısmı sayenizde çözüldü

Tek kalan konu ; soruda 4cü olarak belirttiğim Belge sayfasında eski resmi silerken print ve userform tuşlarının da siliniyor olması. Bu konuda DİLEKÇE AÇ Tuşu kodları için bir öneriniz olabilir mi ?

 

[halit3]

Bu dosyayı irdele

 

[cems]

İki sorunu buldum , kalanı daha sonra salim kafa ile daha dikkatle irdeleyeceğim ve sonucu sizinle paylaşacağım .

Şu anlık ikiz isim süzgecindeki satır sıçraması ve Belge sayfasında resmin kendi karesine eşit boyda oturması ile, bu resmin sonraki bir dilekçede görünmemesi için silen kodun , aynı zamanda 2 tuşu da silmesi sorunu kaldı.

Desteğiniz için teşekkür ederim

 

[halit3]

İki sorunu buldum , kalanı daha sonra salim kafa ile daha dikkatle irdeleyeceğim ve sonucu sizinle paylaşacağım .

Şu anlık ikiz isim süzgecindeki satır sıçraması ve Belge sayfasında resmin kendi karesine eşit boyda oturması ile, bu resmin sonraki bir dilekçede görünmemesi için silen kodun , aynı zamanda 2 tuşu da silmesi sorunu kaldı.

Desteğiniz için teşekkür ederim

4 nolu mesajdaki dosyayı indirip deneme yaptınızmı?

Şu anlık ikiz isim süzgecindeki satır sıçraması ve Belge sayfasında resmin kendi karesine eşit boyda oturması ile, bu resmin sonraki bir dilekçede görünmemesi için silen kodun , aynı zamanda 2 tuşu da silmesi sorunu kaldı.

bu bölümü adım adım anlatırmısınız ne işlem yapınca sonuç istediğiniz gibi çıkmıyor.

resim eklemesi yapınca sayfadaki komut düğmelerini silmiyor.

dosyanızdaki komut düğmelerini silen prosedür bu

ActiveSheet.DrawingObjects.Delete

bu bölümü kodlarınızın hepsinden silmeniz gerekiyor.

 

[cems]

Evet , dosyanızı indirip çalıştırdım ve farkları buldum .Tam ve istenen algoritmisine de uygun bir karşılaştırmayı yaparak bölük pörçük olmayan ve düzeltildiği halde farketmediğimin kalmaması için soru sahibinden zaman istedim, size en optimum açıklama ile yarın akşam saatlerinde , dosyanın son hali ile beraber döneceğim .

EK : Siz belgeye resim gönderme ve ayarları konusunu da halletmişsiniz . İki dosya üstüste bakarken ben ilintiyi iki dosyadaki kodlar ile dosyalar aynı anda üstüste açık olunca kaçırmışım. Dikkatsizliğim için kusuruma bakmayın

Teker teker kontrol edip sonucu paylaşacağım .

 

[cems]

Göndermiş olduğunuz ve incelememi önerdiğiniz dosyada ;

Resim işlemleri , 5000+ satır veride aşırı yer gerekeceği için iptal edildi . Ancak örnekteki işlemleri başka ve personel işlemlerini konu alan 80 kişilik bir çalışmama uyarladım , teşekkür ederim

Bu çalışmadaki senaryo:
Userform üzerinden girişi yapılan bir data listesi ile , diploma ya da tasdikname için dilekçe ve onay sayfası yaratmak .

Yapılanlar :
20 adet textbox yardımı ile data girişi
1 Adet Listbox ile sayfadaki verilerin görünürleştirimesi
Kaydet Bul Değiştir Sil + Dipl sureti ve tasdik sureti tuşları
İsim soyad tarayarak listboxu süzen 21ci ve TC kimlik no süzen 22ci textbox ile bul tuşu.

Akış:
Girişi yapılmış veri ilk olarak TC süzerek aranıyor. Bulunduğunda başka eksik veri yoksa suretlerden biri çıkarılıyor. TC kimlik no bulunamazsa ;
İsim soyad ile aranıyor, listboxta benzeri de gelirse doğru olan satır tıklanarak bilgi kutulara alınıyor , daha sonra suretlerden biri çıkarılıyor.

Sorun : Eksik olan veriyi ( örneğin TC K no veya başka ) yerleştirip DEĞİŞTİR tuşu ile sabitleyemedim . Tuşun altındaki kodlar karma karışık oldu.

Sorun : Herhangi arama kutusu ile yapılan aramaların sonucunda listboxtaki tarih sütunlarının formatı bozuluyor.

Sorun : Textbox15 te mezun görünüyorsa tasdik ; tasdikname görünüyorsa mezun tuşunda uyarı gelmesi ve baskıyı engellemesi gerekli.

Sorun: İstenen suretin detayı , baskı alındığında türüne göre ( Diploma veya TASDİK adlı ek bir sayfada ) sistemden alınacak tarih ve işlem saati ile satır data olarak altalta arşivlenmesi gerekli.

 

[halit3]

ekli dosyayı irdeleyiniz

not açılışdaki kodları ben pasif yaptım.

 

[cems]

ekli dosyayı irdeleyiniz
not açılışdaki kodları ben pasif yaptım.

Açılış kodlarını pasifize etmeyi unuttum , kusura bakmayın.

Kısa bir kontrol olarak, nasıl bir sihir taşıdığını bilmediğim parmaklarınızla bana mantığı çizdirmiş ve sorun olarak bildirdiklerimin hepsini bir çırpıda halletmişsiniz elleriniz dert görmesin ...

Gece saatlerinde ise derin kontrol yaparak benim kendi eksiklerimi tamamlayıp , örnek verdiğiniz ( arşiv ) sayfalarını tamamlamam ile deneme sürüşü için isteğin sahibine sanırım hafta başında kullanılır şekilde gönderebileceğim.

Bütün destekleriniz için tekrar çok teşekkür ederim .

 

[cems]

Sayın Halit3

Aynı programda userform üstünde bulunan SİL tuşuna basıldığında msgboxlar sorunsuz çalışırken kodlar userformu boşaltıyor ama sayfadan ilgili satırı silmiyor. Dolayısı ile tekrar geri çağrılabiliyor. Şu an mevcut kodlar :

Private Sub CommandButton4_Click()  ' SİL
Sheets("sayfa1").Select
If TextBox41 = "TC K No  ile Bul" Then
MsgBox "İlk önce TC Kimlik no girip BUL tuşu ile silmek istediğiniz veriyi bulmalısınız!", vbCritical
Exit Sub
End If

Onay = MsgBox("Seçtiğiniz kayıt geri dönüşsüz silinecektir! Onaylıyor musunuz?", vbExclamation + vbYesNo)
If Onay = vbNo Then Exit Sub

For i = 1 To 20
Me.Controls("TextBox" & i).Text = ""
Next i
ActiveCell.EntireRow.Delete
MsgBox " Seçtiğiniz kayıt geri dönüşsüz olarak silindi ve form boşaltıldı    "
TextBox41 = ""
ThisWorkbook.Save
userform_Initialize
End Sub

Kodlarda nasıl bir düzeltme yapmam gerek ?

 

[halit3]

Bu kodu bir dene silme yaptıktan sonra sıra numarasını yeniden vermek gerekiyor yaksa kodlar indis numarası yanlış olacağından hata verecektir.

kod:

Private Sub CommandButton4_Click()  ' SİL
If ActiveCell.Row < 2 Then
MsgBox "İlk önce BUL tuşu ile silmek istediğiniz veriyi bulmalısınız!", vbCritical
Exit Sub
End If

Onay = MsgBox("Seçtiğiniz kayıt geri dönüşsüz silinecektir! Onaylıyor musunuz?", vbExclamation + vbYesNo)
If Onay = vbNo Then Exit Sub
ListBox1.RowSource = ""

sat = Val(TextBox1.Value) + 4
Worksheets("sayfa1").Rows(sat).Delete Shift:=xlUp
son = Worksheets("sayfa1").Cells(Rows.Count, "B").End(3).Row

For i = 5 To son
Worksheets("sayfa1").Cells(i, "A").Value = i - 4
Next i

For i = 1 To 20
Me.Controls("TextBox" & i).Text = ""
Next i

MsgBox " Seçtiğiniz kayıt geri dönüşsüz olarak silindi ve form boşaltıldı    "
ThisWorkbook.Save
acılis
End Sub

 

[cems]

Önerdiğiniz kodlar sorunsuz şekilde silmeyi gerçekleştirdi. Çok teşekkür ederim

Kaynağını bilmiyorum , ancak açılışta textbox1 de kayda hazır doğru numara olması için son sıra no +1 amaçlı olarak userform açılış kodlarına eklediğim :

 TextBox1 = Application.WorksheetFunction.Max(Sheets("sayfa1").Range("a:a")) + 1

satırı ekteki fotoğrafta görünen şekilde daha açılışta hata veriyor. 5000 satırlık veride el ile son sayıyı görmek mümkün ya da kolay olmayacak. Bu durumda , açılış veya yeni veri girişinde sıra numarasını otomatik alması için bu satırı nasıl çalıştırabilirim ?

İlginç olan ; debug değil end ile kapattığımda userform kapanıyor. Sayfadan tuşla userformu çağırınca sıra numarası doğru olarak geliyor. İnitialize dışında bir yerden gelip gelmediğini kontrol için bu satırı ' ile susturduğumda ; hayır , başka yerden almıyor boş kalıyor.

 

[halit3]

Kaydet komut düğmesini aşağıdaki ile değiştirin yukarıdaki textbox1 e ait koduda silin ona gerek yok.

Private Sub CommandButton1_Click()

sor = MsgBox("Bu tuş ile yeni girilen veri YENİ BİR VERİ olarak kaydedilecektir. Amacınız bazı bilgileri değiştirme ise bu kontrolden çıkıp DEĞİŞTİR tuşunu kullanınız", vbYesNo, "DİKKATLİ OLUNUZ ! ")
If sor = vbNo Then
Exit Sub
End If
ListBox1.RowSource = ""
son = Worksheets("sayfa1").Cells(Rows.Count, "B").End(3).Row + 1

For i = 1 To 20
Sheets("sayfa1").Cells(son, i).Value = Me.Controls("TextBox" & i).Text
Me.Controls("TextBox" & i).Text = ""
Next i

Sheets("sayfa1").Cells(son, 1).Value = son - 4

MsgBox " Kayıt başarı ile girildi"
acılis

ThisWorkbook.Save

End Sub

 

[halit3]

TextBox1 = Worksheets("sayfa1").Cells(Rows.Count, "B").End(3).Row - 3

illaki yapacaksanız böyle yapın ama gerek kalmadı çünkü kaydet düğmesi bu işlemi yapıyor.

 

[cems]

Sizin kodlarınızla ilk anda açılışta da kayıt yaptıktan sonra da textbox1 çalışmadı.

Kodlarınıza şu şekilde ek yaptım

Private Sub CommandButton1_Click()
sor = MsgBox("Bu tuş ile yeni girilen veri YENİ BİR VERİ olarak kaydedilecektir. Amacınız bazı bilgileri değiştirme ise bu kontrolden çıkıp DEĞİŞTİR tuşunu kullanınız", vbYesNo, "DİKKATLİ OLUNUZ ! ")
If sor = vbNo Then
Exit Sub
End If
ListBox1.RowSource = ""
son = Worksheets("sayfa1").Cells(Rows.Count, "b").End(3).Row + 1
TextBox1 = son + 1
For i = 1 To 20
Sheets("sayfa1").Cells(son, i).Value = Me.Controls("TextBox" & i).Text
Me.Controls("TextBox" & i).Text = ""
Next i
Sheets("sayfa1").Cells(son, 1).Value = son - 4
MsgBox " Kayıt başarı ile girildi"

[b]TextBox1 = Application.WorksheetFunction.Max(Sheets("sayfa1").Range("A:A")) + 1[/b]

userform_Initialize
ThisWorkbook.Save
End Sub

Bu şekilde açılışta bir şey yok ama kayıt yapınca , doğru olarak çalıştı.

ve son verdiğiniz satır olan

TextBox1 = Worksheets("sayfa1").Cells(Rows.Count, "B").End(3).Row - 3

satırını da initialize içine attım ve bir çok kere açılış ve kayıt ile sil denedim.

Kodlarda beklediğim olası çatışma olmadı ve her şekilde ( açılış ve işlemlerin hepsinde ) textbox1 ilk boş satıra düşmesi gereken sayıyı sıkıntısız verdi. Şimdilik istenen şekle oturdu gibi..

Diğer denemelerin sonucunu Pazar günü sunabileceğim . Bir kere daha zor'dan ,öğreten bir lisanla kurtardınız , Allah razı olsun , göz nurunuz ve bilginiz paha biçilmez ...

 

[halit3]

Size dosyanın son halini ekliyorum.

 

[cems]

Size dosyanın son halini ekliyorum.

Müteşekkirim , Sayın Halit3 , pazar günü keyifli bir inceleme ile desteğiniz sayesinde nihayete erer bu konu