İzin Cetveli Otomatikleştirme

[uyecik]

Problemim her ay düzenli olarak personellerin izin günlerini işliyorum. Bu işlemi otomatikleştirebilirmiyiz. Mümkünse formüllerle makro olursa bir hata çıkınca baş edemiyorum.
Şimdiden yardım eden veya etmeye çalışan herkese teşekkürler.

 

[Necdet]

Merhaba,

Fonksiyonla nasıl yapılır bilemiyorum, aynı kişiye ait ay içinde bir kaç defa izin kullandığında, ya da kullanmak istenilen izin ilgili ayı aşan süre olduğunda nasıl olur bilemiyorum.

Nacizane makro ile yaptığım çözümü sunuyorum.
Yapmanız gereken ilk iş çalıştığınız işyerindeki personelleri tanımlamak olacaktır.

Yeni açılacak sayfalar özelliğini Şablon sayfasından almaktadır.

İlgili personele ait izin süresi ve tarihini girdiğinizde otomatik olarak ilgila ay sayfasına atacaktır. İlgili sayfa da otomatik olarak açılır.
Yapmadığım şey ise alınan izin bir sonraki aya uzuyorsa bu durumda sadece mesaj verdim, dikkatinizi çekmek için.


Kodlar gerek modülde gerekse de BuÇalışmaKitabı ve ilgili sayfanın kod bölümlerinde.

Deneyin isterseniz.

BuÇalışmaKitabı Kodları :

Private Sub Workbook_Open()

    Sheets("Ana Sayfa").Select
    Range("A" & Cells(Rows.Count, "A").End(3).Row + 1).Select
   
End Sub

Personel Sayfası Kodları :

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, [A:A]) Is Nothing Or Target.Row < 2 Then Exit Sub
   
    On Error Resume Next
   
    Application.EnableEvents = False
   
    If Not Target.Value = "" Then Target = SoyadBuyuk(Target.Value)
   
    Application.EnableEvents = True
   
End Sub

Modul'deki kodlar :

Function WksExists(wksName As String) As Boolean

    On Error Resume Next
    WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
   
End Function

Function SoyadBuyuk(AdSoyad As String)

    Dim d

    AdSoyad = StrReverse(WorksheetFunction.Proper(AdSoyad))
    d = Split(AdSoyad, " ")
    d(0) = Evaluate("=upper(""" & d(0) & """)")
    SoyadBuyuk = StrReverse(Join(d))
    'Kod Sayın Veysel EMRE'ye aittir, Teşekkürler
   
End Function

Ana Sayfadaki tüm kodlar :

Private Sub Worksheet_Activate()

    Application.MoveAfterReturnDirection = xlToRight
    
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, [A:C]) Is Nothing Or Target.Row < 2 Then Exit Sub
    
    'A-C arası tüm hücreler dolu değilse  çık
    If WorksheetFunction.CountA(Range("A" & Target.Row & ":C" & Target.Row)) < 3 Then Exit Sub
    
    Dim AyAdi   As String, _
        Sh      As Worksheet, _
        c       As Range, _
        i       As Long, _
        j       As Long, _
        Tar     As Date
    
    AyAdi = Evaluate("=upper(""" & Format(Range("B" & Target.Row), "mmmm") & """)")
    
    Tar = Cells(Target.Row, "B") + Cells(Target.Row, "C")
    If Not Month(Tar) = Month(Cells(Target.Row, "B")) Then
        MsgBox "Gelecek Aya Ait Veri Oluştu........ " & _
        Day(DateSerial(Year(Tar), Month(Tar), 0)) - Day(Cells(Target.Row, "B")) - 1 & _
            " Günü " & AyAdi & " için kullanın, geri kalanını bir sonraki ay için yeni kayıt açın.."
            
        
    End If
    
    If WksExists(AyAdi) = False Then
        Application.ScreenUpdating = False
        Sheets("Şablon").Copy After:=Sheets(Sheets.Count)
        ActiveSheet.Name = AyAdi
        Application.ScreenUpdating = True
        Sheets("Ana Sayfa").Select
    End If
    
    Set Sh = Sheets(AyAdi)
    
    Set c = Sh.Range("A:A").Find(Range("A" & Target.Row), LookAt:=xlWhole)
    If Not c Is Nothing Then
        i = c.Row
    Else
        i = Sh.Cells(Rows.Count, "A").End(3).Row + 1
        Sh.Cells(i, "A") = Cells(Target.Row, "A")
        Sh.Cells(i, "AG").Formula = "=COUNTA(B" & i & ":AF" & i & ")"
    End If
    
    For Tar = Cells(Target.Row, "B") To Cells(Target.Row, "B") + Cells(Target.Row, "C") - 1
        If Month(Tar) = Month(Cells(Target.Row, "B")) Then Sh.Cells(i, Day(Tar) + 1) = "İ"
    Next Tar
    
    
    
    Set Sh = Nothing
    Set c = Nothing
    
End Sub

Private Sub Worksheet_Deactivate()

    Application.MoveAfterReturnDirection = xlDown

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Target.Row < 2 Then Exit Sub
    
    If Target.Column = 1 Then
        With Target.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:="=Personel"
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
    ElseIf Target.Column > 3 Then
        Range("A" & Target.Row + 1).Select
    End If
    
End Sub

 

[ckarabacak]

Sayın uyecik Merhaba

Ekli dosya da formül ile yapılan izin takibi işinizi görürmü?

 

[uyecik]

s(ActiveSheet.

Merhaba,

Fonksiyonla nasıl yapılır bilemiyorum, aynı kişiye ait ay içinde bir kaç defa izin kullandığında, ya da kullanmak istenilen izin ilgili ayı aşan süre olduğunda nasıl olur bilemiyorum.

Nacizane makro ile yaptığım çözümü sunuyorum.
Yapmanız gereken ilk iş çalıştığınız işyerindeki personelleri tanımlamak olacaktır.

Yeni açılacak sayfalar özelliğini Şablon sayfasından almaktadır.

İlgili personele ait izin süresi ve tarihini girdiğinizde otomatik olarak ilgila ay sayfasına atacaktır. İlgili sayfa da otomatik olarak açılır.
Yapmadığım şey ise alınan izin bir sonraki aya uzuyorsa bu durumda sadece mesaj verdim, dikkatinizi çekmek için.


Kodlar gerek modülde gerekse de BuÇalışmaKitabı ve ilgili sayfanın kod bölümlerinde.

Deneyin isterseniz.

BuÇalışmaKitabı Kodları :

Private Sub Workbook_Open()

    Sheets("Ana Sayfa").Select
    Range("A" & Cells(Rows.Count, "A").End(3).Row + 1).Select
   
End Sub

Personel Sayfası Kodları :

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, [A:A]) Is Nothing Or Target.Row < 2 Then Exit Sub
   
    On Error Resume Next
   
    Application.EnableEvents = False
   
    If Not Target.Value = "" Then Target = SoyadBuyuk(Target.Value)
   
    Application.EnableEvents = True
   
End Sub

Modul'deki kodlar :

Function WksExists(wksName As String) As Boolean

    On Error Resume Next
    WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
   
End Function

Function SoyadBuyuk(AdSoyad As String)

    Dim d

    AdSoyad = StrReverse(WorksheetFunction.Proper(AdSoyad))
    d = Split(AdSoyad, " ")
    d(0) = Evaluate("=upper(""" & d(0) & """)")
    SoyadBuyuk = StrReverse(Join(d))
    'Kod Sayın Veysel EMRE'ye aittir, Teşekkürler
   
End Function

formü

Her ikinize de çok teşekkür ederim. @ckarabacak sizinki güzel ama benim için çok detaylı yine de çok teşekkür ederim.
@Necdet sizinkisi ise tam benim ihtiyacım olmuş. Çok teşekkür ederim. Aslında makroya hiç bulaşmak istemiyordum ama böylelikle bilmediğim bazı şeyleri de öğrenmiş olurum. ellerinize sağlık.