yıllık izinde açıklama için yardım istiyorum

[Hacı Bayram ÖZKAN]

Korhan bey; eğer müsait olursanız ekte sunduğum dosyada bir yardım daha istiyorum, sorumu dosya üzerinde açıkladım yardımcı olursanız sevinirim. Teşekkürler. Yardım etmek isteyen diğer arkadaşlarda yardımcı olabilir.

 

[Hacı Bayram ÖZKAN]

Korhan bey bu dosyaya bakarmısın sana zahmet daha öncesinden sizin emeğiniz vardı.

 

[Korhan Ayhan]

Selamlar,

Modül2 deki kodlarınızı aşağıdaki şekilde değiştirip denermisiniz.

Sub KART()
    If [I15] = "" Then Exit Sub
    Application.ScreenUpdating = False
    metin = [I15]
    Sheets("İZİN_KARTLARI").Select
    With Range("C:C")
        .Find(Sheets("İZİN BELGESİ").Cells(9, 5).Value, , , xlWhole).Activate
        sk = Range("IV" & ActiveCell.Row).End(1).Column + 1
        If sk < 6 Then sk = 6
        For x = 6 To 15
        If Sheets("İZİN BELGESİ").Range("G17").Value > 0 Then
        If Cells(ActiveCell.Row, x).Interior.ColorIndex = 4 Then
        If MsgBox(Cells(ActiveCell.Row, "B") & " isimli personel daha önce yol izni kullanmıştır. İKİNCİ KEZ VERMEK İSTİYOR MUSUNUZ?", vbCritical + vbYesNo) = vbNo Then
        Cells(ActiveCell.Row, sk) = metin
        GoTo Son
        Else
        Exit For
        End If
        End If
        End If
        Next
        With Cells(ActiveCell.Row, sk)
            .Value = metin
            If Sheets("İZİN BELGESİ").Range("G17").Value > 0 Then
            On Error Resume Next
            .Comment.Delete
            On Error GoTo 0
            .AddComment
            .Comment.Visible = False
            .Comment.Text Text:="HACI:" & Chr(10) & Sheets("İZİN BELGESİ").Range("E24") & " tarihinde almış olduğu yıllık izninde " & Sheets("İZİN BELGESİ").Range("G17") & " gün yol izni kullanmıştır."
            End If
        End With
    End With
    If Sheets("İZİN BELGESİ").Range("G17").Value > 0 Then Cells(ActiveCell.Row, sk).Interior.ColorIndex = 4
Son:
    Sheets("İZİN BELGESİ").Select
    Range("I15:J15") = ""
    Application.ScreenUpdating = True
    mesaj = MsgBox("BU İZNİ KARTA İŞLEDİM...", vbOKOnly, " MEMUR BEY ...")
    Sheets("İZİN BELGESİ").Select
    ActiveWindow.SmallScroll
    Range("I24").Select
    ActiveWorkbook.Save
End Sub
 
Sub SİL()
    If MsgBox("İZİN KARTLARINI SİLMEYİ ONAYLIYOR MUSUNUZ?", vbInformation + vbYesNo, "..::LÜTFEN DİKKAT::..") = vbNo Then Exit Sub
    With Sheets(3).Range("F2:O200")
        .Value = ""
        .Interior.ColorIndex = xlNone
    End With
    
    On Error Resume Next
    Columns("F:O").SpecialCells(xlCellTypeComments).ClearComments
    On Error GoTo 0
End Sub

 

[Hacı Bayram ÖZKAN]

Korhan bey eline sağlık teşekkürler, eksik olmayın.