Dosya bazlı evrak takip raporu oluşturma

[honestman]

Merhaba,

Ekteki örnekte belirttiğim üzere yazıcıdan çıktı alabileceğim dosya bazlı rapor oluşturmak istiyorum.

 

[Emir Hüseyin Çoban]

. . .

Bir dosya numarası yazarak rapor mu almak istiyorsunuz yoksa
tüm listeyi sırayla raporlayıp yazdırmak mı.

. . .

 

[honestman]

Aslında tüm listedeki dosyalar için tek seferde oluşturmak istiyorum. Amacım her dosya için böyle bir son durum kapağı oluşturmak. Ama dosya no girerek dosyanon son durumu nedir görebilirsem iyi olur.
Burada kullanıcı tick işareti koyduğunda anlık olarak veya bir butonla update ederek oluşan kapak raporda ilgili evrak isminin yanında "(geldi)", x koyduysa "(gelmedi)" yazması.

 

[honestman]

Yardımcı olabilir misiniz?

 

[Emir Hüseyin Çoban]

. . .

Renklendirme önemli mi.

. . .

 

[honestman]

Hayır geldi, gelmedi demesi öneml olan

 

[Emir Hüseyin Çoban]

. . .

RAPOR sayfası oluşturup kodları çalıştırın.

Sub KOD()
    Application.ScreenUpdating = False
    Dim S1 As Worksheet: Set S1 = Sheets("Sayfa1")
    Dim SR As Worksheet: Set SR = Sheets("RAPOR")
    
    bir = "EVRAK 1 "
    iki = "EVRAK 2 "
    üç = "EVRAK 3 "
    notlar = "olağandışı evrak "
    
    SR.Range("A:B").ClearContents
    
    For i = 2 To S1.Cells(Rows.Count, "A").End(3).Row
        
        If S1.Cells(i, "A") <> "" Then
            
            If S1.Cells(i, "C") = "X" Then
                x1 = "(GELMEDİ)"
            Else
                x1 = "(GELDİ)"
            End If
            
            If S1.Cells(i, "D") = "X" Then
                x2 = "(GELMEDİ)"
            Else
                x2 = "(GELDİ)"
            End If
            
            
            If S1.Cells(i, "E") = "X" Then
                x3 = "(GELMEDİ)"
            Else
                x3 = "(GELDİ)"
            End If
            
            
            If S1.Cells(i, "G") = "X" Then
                x4 = "(GELMEDİ)"
            Else
                x4 = "(GELDİ)"
            End If
            
            sat = SR.Cells(Rows.Count, "A").End(3).Row + 2
            
            SR.Cells(sat, "A") = "Dosya No : "
            SR.Cells(sat, "B") = S1.Cells(i, "A")
            
            SR.Cells(sat + 1, "A") = "Evraklar : "
            SR.Cells(sat + 1, "B") = bir & x1 & ", " & iki & x2 & ", " & üç & x3
            
            SR.Cells(sat + 2, "A") = "Notlar : "
            SR.Cells(sat + 2, "B") = notlar & x4
            
            SR.Cells(sat + 3, "A") = "Tutar : "
            SR.Cells(sat + 3, "B") = S1.Cells(i, "B")

        End If
    Next i
    Application.ScreenUpdating = True
    MsgBox "B i t ti "
End Sub

. . .

 

[honestman]

notlar = "olağandışı evrak " yerine kullanıcının her dosya için olağan dışı olarak yazdığı not aynen gelmeli

 

[Emir Hüseyin Çoban]

. . .

Sub KOD()
    Application.ScreenUpdating = False
    Dim S1 As Worksheet: Set S1 = Sheets("Sayfa1")
    Dim SR As Worksheet: Set SR = Sheets("RAPOR")
    
    bir = S1.Range("C1")
    iki = S1.Range("D1")
    üç = S1.Range("E1")
    'notlar = "olağandışı evrak "
    
    SR.Range("A:B").ClearContents
    
    For i = 2 To S1.Cells(Rows.Count, "A").End(3).Row
        
        If S1.Cells(i, "A") <> "" Then
            
            If S1.Cells(i, "C") = "X" Then
                x1 = "(GELMEDİ)"
            Else
                x1 = "(GELDİ)"
            End If
            
            If S1.Cells(i, "D") = "X" Then
                x2 = "(GELMEDİ)"
            Else
                x2 = "(GELDİ)"
            End If
            
            
            If S1.Cells(i, "E") = "X" Then
                x3 = "(GELMEDİ)"
            Else
                x3 = "(GELDİ)"
            End If
            
            
            If S1.Cells(i, "G") = "X" Then
                x4 = "(GELMEDİ)"
            Else
                x4 = "(GELDİ)"
            End If
            
            sat = SR.Cells(Rows.Count, "A").End(3).Row + 2
            
            SR.Cells(sat, "A") = "Dosya No : "
            SR.Cells(sat, "B") = S1.Cells(i, "A")
            
            SR.Cells(sat + 1, "A") = "Evraklar : "
            SR.Cells(sat + 1, "B") = bir & x1 & ", " & iki & x2 & ", " & üç & x3
            
            notlar = S1.Cells(i, "F")
    
            SR.Cells(sat + 2, "A") = "Notlar : "
            SR.Cells(sat + 2, "B") = notlar & x4
            
            SR.Cells(sat + 3, "A") = "Tutar : "
            SR.Cells(sat + 3, "B") = S1.Cells(i, "B")

        End If
    Next i
    Application.ScreenUpdating = True
    MsgBox "B i t ti "
End Sub

. . .

 

[honestman]

Sayenizde çok şey öğreniyorum. Aslında çok zor değilmiş. Teşekkürler.

 

[Emir Hüseyin Çoban]

. . .

Bu tarz seçenekli çalışmalarda seçimi aşağı açılan listeden yaptırmak daha iyidir.
Örneğin tablonuz da küçük x kullanırsanız mevcut kodlamalar bunu algılayamaz.
Ancak ekranda sizin istediğiniz gibi kırmızı x görünür.
Kodlar revize edebilebilir.

Tablonuzda seçim işlemini veri doğrulama ile yaptırmanız daha iyi olur.

. . .

 

[honestman]

Hücreler arasında boşluk olduğundan filtre veya hlookup ile aradığım bir dosyanın durumunu göremedim malesef. Veri doğrulamayı nasıl kullanmalıyım?

 

[Emir Hüseyin Çoban]

C-D-E-G hücre aralığı seçin
Veri doğrulama - liste
"ü";"X" girin

.

 

[Emir Hüseyin Çoban]

Hücreler arasında boşluk olduğundan filtre veya hlookup ile aradığım bir dosyanın durumunu göremedim malesef. Veri doğrulamayı nasıl kullanmalıyım?

. . .

Düşeyara ile deneyin.

. . .

 

[Subebul]

tşkler