Kimlik verileri hazırlamak

[andon]

Merhaba
Kapsamlı ama ben dahil bir çok kişinin işine yarayabileceğini düşündüğüm excell tabanlı ve kapsamlı bir tablo hazırlamaya çalıştım.
İş kapsamlı olunca benim bilgim çok fazla işin gerisinde kaldı ve ben de tabloda herhangi bir kod kullanmadan çıplak haliyle buradaki hocalarımızın bu işte bizlere yardımcı olabilecğeini düşündüm.
Yapılması gerekenlerle alakalı bilgiler tablonun bulunduğu excell sayfası içinde açıklanmıştır.
Zaman ayırıp hocalarımız ilgilenirlerse çok minnettar olurum...

 

[İhsan Tank]

Merhaba
Kapsamlı ama ben dahil bir çok kişinin işine yarayabileceğini düşündüğüm excell tabanlı ve kapsamlı bir tablo hazırlamaya çalıştım.
İş kapsamlı olunca benim bilgim çok fazla işin gerisinde kaldı ve ben de tabloda herhangi bir kod kullanmadan çıplak haliyle buradaki hocalarımızın bu işte bizlere yardımcı olabilecğeini düşündüm.
Yapılması gerekenlerle alakalı bilgiler tablonun bulunduğu excell sayfası içinde açıklanmıştır.
Zaman ayırıp hocalarımız ilgilenirlerse çok minnettar olurum...

merhaba
dosyanızı 2003 formatında yüklermisiniz

 

[andon]

merhaba
dosyanızı 2003 formatında yüklermisiniz

excell 2007 nin yanında 2003 olarak da kaydettim ve eki değiştirdim şimdi. İlginize teşekkürler...

 

[Necdet]

Merhaba,

Fotoğraf kontrolü benden olsun. Kırmızı olan yolu kendinize göre ayarlayınız.

Private Sub CommandButton1_Click()
Dim Ref     As Range
Dim Kol     As Integer
Dim SonKol  As Integer
Dim i       As Long
Dim SonSat  As Long
Dim s       As Worksheet
Dim Yol     As String
 
Yol = [COLOR=red][B]"C:\Listeler\Foto\"[/B][/COLOR]
Set s = Sheets("LISTE")
s.Select
Set Ref = Application.InputBox("Kontrol Edilecek Hücreyi Seçiniz", "Seçim", Type:=8)
If Ref Is Nothing Then Exit Sub
Kol = Ref.Column
SonKol = [IV3].End(1).Column
SonSat = Cells(65536, Kol).End(3).Row
Range(Cells(4, "A"), Cells(SonSat, SonKol)).Interior.ColorIndex = xlNone
For i = 4 To SonSat 
     If Dir(Yol & Cells(i, Kol) & ".jpg") = "" Then
        Range(Cells(i, "A"), Cells(i, SonKol)).Interior.ColorIndex = 3
    Else
        Range(Cells(i, "A"), Cells(i, SonKol)).Interior.ColorIndex = 35
    End If
Next i
End Sub

 

[andon]

Merhaba,

Fotoğraf kontrolü benden olsun.

Private Sub CommandButton1_Click()
Dim Ref     As Range
Dim Kol     As Integer
Dim SonKol  As Integer
Dim i       As Long
Dim SonSat  As Long
Dim s       As Worksheet
Dim Yol     As String
Dim Dosya   As String
Yol = "C:\Listeler\Foto\"
Set s = Sheets("LISTE")
s.Select
Set Ref = Application.InputBox("Kontrol Edilecek Hücreyi Seçiniz", "Seçim", Type:=8)
If Ref Is Nothing Then Exit Sub
Kol = Ref.Column
SonKol = [IV3].End(1).Column
SonSat = Cells(65536, Kol).End(3).Row
Range(Cells(4, "A"), Cells(SonSat, SonKol)).Interior.ColorIndex = xlNone
For i = 4 To SonSat
'    Dosya = Yol & Cells(i, Kol) & ".jpg"
    
     If Dir(Yol & Cells(i, Kol) & ".jpg") = "" Then
        Range(Cells(i, "A"), Cells(i, SonKol)).Interior.ColorIndex = 3
    Else
        Range(Cells(i, "A"), Cells(i, SonKol)).Interior.ColorIndex = 35
    End If
Next i
End Sub

Necdet hocam süper olmuş...
Verdiğiniz kodları sayfaya yerleştirdim ve tam da istediğim gibi. Eklenen kodlar ile dosyayı güncelledim...

 

[Necdet]

Merhaba,

bende yukarıdaki kodlarda fazlalıkları silip güncelledim.

 

[andon]

Teşekkürler hocam...
İhsan hocamdan ses çıkıyor sanırım bitirmiş halde karşımıza çıkacak

 

[Necdet]

Merhaba,

Fotoğrafı olmayanlar için kodlar aşağıdadır.

Private Sub CommandButton5_Click()
Dim SonKol  As Integer
Dim i       As Long
Dim SonSat  As Long
Dim s1      As Worksheet
Dim s2      As Worksheet
Dim Yol     As String
Set s1 = Sheets("LISTE")
Set s2 = Sheets("FOTO_OLMAYAN")
SonSat = s2.[B65536].End(3).Row
s1.Select
SonKol = [IV3].End(1).Column
Application.ScreenUpdating = False
For i = [B65536].End(3).Row To 4 Step -1
    If Cells(i, "B").Interior.ColorIndex = 3 Then
        SonSat = SonSat + 1
        Range(Cells(i, "A"), Cells(i, SonKol)).Copy s2.Cells(SonSat, "A")
        Rows(i).Delete
    End If
Next i
Application.ScreenUpdating = True
MsgBox "Foto olmayanları Çıkarttım"
End Sub

 

[andon]

Teşekkürler Necdet hocam
Necdet hocanın gönderdiği kodları da ilave ettim ve foto kısmı tamamlanmış oldu...
İnşaallah diğer kısımları da bu kadar güzel halledebiliriz.

 

[Necdet]

Merhaba,

Teslim Sayfasına aktarım kodları aşağıdadır, umarım Toplam sayfasına aktarımı bu kodlara bakarak yapabilirsiniz.

Private Sub CommandButton2_Click()
 
'------- Teslim Listesi Oluşturma -------
Dim i       As Long
Dim SonSat  As Long
Dim s1      As Worksheet
Dim s2      As Worksheet
Set s1 = Sheets("LISTE")
Set s2 = Sheets("TESLIM")
SonSat = s2.[B65536].End(3).Row 'Teslim sayfasının son kayıdı
For i = 4 To s1.[B65536].End(3).Row 'Liste sayfasının 4. satırından son satırına kadar döngü kuruldu
    SonSat = SonSat + 1
    s2.Cells(SonSat, "B") = s1.Cells(i, "B")
    s2.Cells(SonSat, "C") = s1.Cells(i, "D")
    s2.Cells(SonSat, "D") = s1.Cells(i, "E")
    s2.Cells(SonSat, "E") = s1.Cells(i, "L")
Next i
MsgBox """TESLİM"" Sayfasına Aktarım Tamamlanmıştır"
End Sub

 

[andon]

Hocam emeğinize sağlık
Ben dediğininiz gibi diğer kodlardan yardım alarak diğer sayfaları düzenlemeye çalıştım.
Bunun yanında; LISTE sekmesindeki kişileri TOPLAM_LISTE sayfasına aktarırken MUKERRER sütununda kişilerin karşısına B sütunundaki numaraları baz alarak, kişinin kaydı ilk kez atılıyorsa "1" yazsın, ikinci kez atılıyor ise "2",...onuncu kez atılıyor ise "10" yazsın. Yani bu durumda kişileri TOPLAM_LISTE'ye aktarırken daha önce kaydı varmı diye sorgulama da yapmalı.
(Son yapılan değişikliklerden sonra listenin güncel halini paylaşıyorum)

 

[andon]

Merhaba
Bu günde devam edecekmiyiz acaba?..

 

[andon]

merhaba
dosyanızı 2003 formatında yüklermisiniz

Hocam fazla müsait olamadınız sanırım. Dosyayı 2003 fotmatında yükledim bi kaç işlemide yaptık ancak sizden ses çıkmadı

 

[andon]

Kimlik Listesi Hazırlama

Geçen hafta hocalarımızın yardımıyla yarı tamamladınımız işte az bir kısım kaldı ancak ben içinden çıkamadım.
Yardımcı olursanız sevinirim..
Gerekli açıklamalar tabloda yazılıdır.