• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Bordro Uygulaması

D

dayi10

Katılım
26 Mayıs 2011
Mesajlar
129
Excel Vers. ve Dili
2007-2010
Merhabalar,

Ekte yapmaya çalıştığım bir bordro uygulaması var. Bunu manuel olarak yapmıştım. Ama şimdi makro ile yapmaya çalışıyorum. Ama yapamadım. yardımcı olabilir misiniz?
 

Ekli dosyalar

teşekkür ederim ellerinize sağlık kuruş farklarını incelerken taahhukta 5 gün girdiğimizde 336,263 olması gerekirken 336,262 oluyor neden olabilir. birde şablonda kenarlık çizgileri olsun en alttaki toplam bölümü olsun orada bozulmalar oluyor bunları nasıl düzeltebiliriz. 1'den 30 güne kadar manuel bordro uygulamasıyla karşılaştırdığımda aşağıdaki farkları veriyor. ekte resmini ekledim inceleyebilirsiniz.
 

Ekli dosyalar

  • Ekran Alıntısı.JPG
    Ekran Alıntısı.JPG
    89.9 KB · Görüntüleme: 13
Son düzenleme:
Sayfada koşullu biçimlendirmeyi gözden geçirin.
Uygun çalışması gerekir, formüllerde bozulma varsa düzeltin.



Kuruş farkları için:
Sub Bordro makro kodlarında ilgili satırı:
Kod: 
s1.Cells(sonsatir, 9) = Application.WorksheetFunction.RoundUp(s1.Cells(sonsatir, 6) + s1.Cells(sonsatir, 7) + s1.Cells(sonsatir, 8), 3)

şeklinde düzelterek deneyin.
 
turist' Alıntı:
Sayfada koşullu biçimlendirmeyi gözden geçirin.
Uygun çalışması gerekir, formüllerde bozulma varsa düzeltin.



Kuruş farkları için:
Sub Bordro makro kodlarında ilgili satırı:
Kod: 
s1.Cells(sonsatir, 9) = Application.WorksheetFunction.RoundUp(s1.Cells(sonsatir, 6) + s1.Cells(sonsatir, 7) + s1.Cells(sonsatir, 8), 3)

şeklinde düzelterek deneyin.
Genişletmek için tıkla ...

Bordro oluştur tuşuna bastığımda Asgari Ücret bordrosu sayfasında A5 ve w65536 aralığını temizlemek için Sheets("Asgari Ücret Bordrosu").Range("A6:W65536").ClearContents şu kodu nereye yazmam gerekir çok denedim ama bulamadım.

koşullu biçimlendirmeyi inceledim. Şablondaki kenarlıklar olsun, kişilerin olduğu bölümlerdeki karakter boyut tipi olsun. Bunların ayarlamaları nereden yapılıyor. bu şablonu nasıl kodlarla uyarlayabiliriz. Ayrıca yardımlarınız için tekrar teşekkür ederim.
 
"Bordro oluştur" tuşuna bastığınızda;
Sub Bordro() isimli makro çalışır.
Bu makro içinde
Kod: 
s1.Range("A5:W1000").ClearContents
şeklinde A5 ile W1000 hücre aralığı temizlenir.
isterseniz bunu
Kod: 
s1.Range("A5:W65536").ClearContents
olarak değiştirebilirsiniz.
Not: "s1" Asgari Ücret Bordrosu sayfası olarak kod başlangıcında
Kod: 
Set s1 = ThisWorkbook.Worksheets("Asgari Ücret Bordrosu")
şeklinde tanımlanmıştır.
Koşullu Biçimlendirme makro kodları ile ilgili değil. Excel üst menüsünde yerleşik olarak yer alır. Ve oradan uyarlama yapabilirsiniz.
Koşullu biçimlendirme konusunda araştırma yaparak uygulama hakkında daha fazla bilgi edinmenizi tavsiye ederim.
 
Bir istek

Merhabalar;


Günaydın. Eklediğiniz ve Sayın turist'in katkı verdiği dosyanız çok ilgimi çekti.

Sayın dayi10 rica etsem, dosyanızın en son düzeltilmiş halini ekleyebilir misiniz?

ilginiz ve yardımınız için önceden teşekkürler.
 
turist' Alıntı:
"Bordro oluştur" tuşuna bastığınızda;
Sub Bordro() isimli makro çalışır.
Bu makro içinde
Kod: 
s1.Range("A5:W1000").ClearContents
şeklinde A5 ile W1000 hücre aralığı temizlenir.
isterseniz bunu
Kod: 
s1.Range("A5:W65536").ClearContents
olarak değiştirebilirsiniz.
Not: "s1" Asgari Ücret Bordrosu sayfası olarak kod başlangıcında
Kod: 
Set s1 = ThisWorkbook.Worksheets("Asgari Ücret Bordrosu")
şeklinde tanımlanmıştır.
Koşullu Biçimlendirme makro kodları ile ilgili değil. Excel üst menüsünde yerleşik olarak yer alır. Ve oradan uyarlama yapabilirsiniz.
Koşullu biçimlendirme konusunda araştırma yaparak uygulama hakkında daha fazla bilgi edinmenizi tavsiye ederim.
Genişletmek için tıkla ...

Teşekkür ederim turist. Yalnız şöyle bir sıkıntı ile karşılaştım. Mesela 35 kişilik bir bordro hazırlanacak. Bu borda daha önce 31 kişilik ise yapılan hesaplamada ekteki dosyada görüldüğü üzere bir önceki bordronun toplamaları 32 satırda görünüyor. Ben clearcontents'i bu sebepten sormuştum. bu konuda yardımcı olabilir misiniz.
Birde koşullu biçimlendirme hakkında bilgim olmadığı için sizden yardım beklemiştim. ama teşekkür ederim yardımlarınız için
 

Ekli dosyalar

Dosyanız eklidir.
Makro kodları ile Koşullu Biçimlendirme sağlanmıştır.
Diğer hatalar kodlarda düzeltilmiştir.İnceleyiniz.
 

Ekli dosyalar

teşekkür ederim turist. ellerine sağlık.

s1.Range("A5:W2000").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

kodlarında xldot yaparak A5 başlayarak arada bordroda kaç kişinin hesaplamaları varsa kenarlık çizgilerinin olması yapmaya çalıştım ama A5:W2000 arasınıdaki hücrelerin çizgilerini çizdi son olarak bunun için yardımcı olabilir misiniz
 
Sub Bordro() Kodunu tamamen silin.
Aşağıdaki gibi değiştirerek deneyin.
Kod: 
Sub Bordro()
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
Sheets("Asgari Ücret Bordrosu").Range("A6:W65536").ClearContents
Set s1 = ThisWorkbook.Worksheets("Asgari Ücret Bordrosu")
Set s2 = ThisWorkbook.Worksheets("Personel girişi")
Set s3 = ThisWorkbook.Worksheets("İşveren Girişi")
Dim alan As Range
Set alan = Cells(Rows.Count, 11).End(xlUp)
Set alan = Range(Range("k4"), alan)
cevap = Application.CountIf(alan, "Aktif")
If cevap = 0 Then
s1.Range("A5:W65536").ClearContents
With s1.Cells
        .FormatConditions.Delete
    End With
MsgBox "Aktif Çalışan Yoktur"

Exit Sub
End If


s1.Activate
s1.Cells.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
s1.Range("C1").Value = s3.Range("H9").Value
s1.Range("C2").Value = s3.Range("H16").Value
s1.Range("W1").Value = s3.Range("B2").Value
s1.Range("w2").Value = s3.Range("D2").Value
s1.Range("A5:W65536").ClearContents
s1.Range("A5:D1000").UnMerge
For i = 3 To s2.Range("B65500").End(xlUp).Row
If s2.Cells(i, "K") = "Aktif" Then
sonsatir = s1.Range("B65500").End(xlUp).Row + 1
s1.Cells(sonsatir, 2) = s2.Cells(i, 3)
s1.Cells(sonsatir, 4) = s2.Cells(i, 2)
s1.Cells(sonsatir, 5) = s2.Cells(i, "J")
s1.Cells(sonsatir, 6) = s1.Range("C2").Value / 30 * s1.Cells(sonsatir, 5).Value
s1.Cells(sonsatir, 7) = s1.Cells(sonsatir, 6) * 20.5 / 100
s1.Cells(sonsatir, 8) = s1.Cells(sonsatir, 6) * 2 / 100
s1.Cells(sonsatir, 9) = Application.WorksheetFunction.RoundUp(s1.Cells(sonsatir, 6) + s1.Cells(sonsatir, 7) + s1.Cells(sonsatir, 8), 3)
s1.Cells(sonsatir, 15) = s1.Cells(sonsatir, 6) * 7.59 / 1000
s1.Cells(sonsatir, 16) = s1.Cells(sonsatir, 7)
s1.Cells(sonsatir, 17) = s1.Cells(sonsatir, 6) * 14 / 100
s1.Cells(sonsatir, 18) = s1.Cells(sonsatir, 8)
s1.Cells(sonsatir, 19) = s1.Cells(sonsatir, 6) * 1 / 100
s1.Cells(sonsatir, 20) = s1.Cells(sonsatir, 16) + s1.Cells(sonsatir, 17) + s1.Cells(sonsatir, 18) + s1.Cells(sonsatir, 19)
s1.Cells(sonsatir, 21) = s2.Cells(i, "I")
s1.Cells(sonsatir, 10) = s1.Cells(sonsatir, 6) - (s1.Cells(sonsatir, 17) + s1.Cells(sonsatir, 19))
s1.Cells(sonsatir, 11) = s1.Cells(sonsatir, 10) * 15 / 100
s1.Cells(sonsatir, 12) = s2.Cells(i, "H")
If s1.Cells(sonsatir, 12) >= s1.Cells(sonsatir, 11) Then
s1.Cells(sonsatir, 13) = s1.Cells(sonsatir, 11)
Else
s1.Cells(sonsatir, 13) = s1.Cells(sonsatir, 12)
End If
s1.Cells(sonsatir, 14) = s1.Cells(sonsatir, 11) - s1.Cells(sonsatir, 13)
s1.Cells(sonsatir, 22) = s1.Cells(sonsatir, 16) + s1.Cells(sonsatir, 17) + s1.Cells(sonsatir, 19) + s1.Cells(sonsatir, 14) + s1.Cells(sonsatir, 15) + s1.Cells(sonsatir, 18) + s1.Cells(sonsatir, 21)
s1.Cells(sonsatir, 23) = s1.Cells(sonsatir, 9) - s1.Cells(sonsatir, 22)

End If
Next i
s1.Range("A1:W4").Select
    Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
    Selection.Borders(xlEdgeTop).LineStyle = xlContinuous
    Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous
    Selection.Borders(xlEdgeRight).LineStyle = xlContinuous
    Selection.Borders(xlInsideVertical).LineStyle = xlContinuous
    Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous
s1.Range("A5:W" & sonsatir).Select
    Selection.Borders(xlEdgeLeft).LineStyle = xlDot
    Selection.Borders(xlEdgeTop).LineStyle = xlDot
    Selection.Borders(xlEdgeBottom).LineStyle = xlDot
    Selection.Borders(xlEdgeRight).LineStyle = xlDot
    Selection.Borders(xlInsideVertical).LineStyle = xlDot
    Selection.Borders(xlInsideHorizontal).LineStyle = xlDot
With Selection
 With Selection.Font
        .Name = "Verdana"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Selection.Font.Bold = False
        .RowHeight = 30
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
diz
merge
topla
Dim ss As Long
ss = s1.Range("A65500").End(xlUp).Row + 1
s1.Range(Cells(ss, 1), Cells(ss, 4)).merge
s1.Cells(ss, 1) = "T  O  P  L  A  M"
s1.Range("A" & ss & ":D" & ss, "E" & ss & ":w" & ss).Select
With Selection
 With Selection.Font
        .Name = "Verdana"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Selection.Font.Bold = True
        .RowHeight = 50
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
 With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext

    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext

    End With
    
s1.Range(Cells(ss + 1, 1), Cells(ss + 1, 23)).merge
s1.Cells(ss + 1, 1) = s1.Cells(1, "C") & " 'nde çalışan işçilerin " & s1.Cells(2, "W") & " - " & s1.Cells(1, "W") & " dönemi hakedişleri  " & Format(s1.Cells(ss, "I"), "#,##0.00") & " TL tahakkuk ettirilmiştir."
s1.Rows(ss + 1).Select
With Selection
 With Selection.Font
        .Name = "Verdana"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Selection.Font.Bold = True
        .RowHeight = 52
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
  s1.Range(Cells(ss + 3, 1), Cells(ss + 3, 3)).merge
  s1.Range(Cells(ss + 4, 1), Cells(ss + 4, 3)).merge
  s1.Range(Cells(ss + 5, 1), Cells(ss + 5, 3)).merge
  s1.Range(Cells(ss + 6, 1), Cells(ss + 6, 3)).merge
  s1.Cells(ss + 3, 1) = "Düzenleyen"
  s1.Cells(ss + 4, 1) = s3.Range("H2")
  s1.Cells(ss + 5, 1) = s3.Range("H3")
  s1.Cells(ss + 6, 1) = s3.Range("H4")
  
  s1.Range(Cells(ss + 3, 8), Cells(ss + 3, 10)).merge
  s1.Range(Cells(ss + 4, 8), Cells(ss + 4, 10)).merge
  s1.Range(Cells(ss + 5, 8), Cells(ss + 5, 10)).merge
  s1.Range(Cells(ss + 6, 8), Cells(ss + 6, 10)).merge
  s1.Cells(ss + 3, 8) = "Harcama Yetkilisi"
  s1.Cells(ss + 4, 8) = s3.Range("H2")
  s1.Cells(ss + 5, 8) = s3.Range("H6")
  s1.Cells(ss + 6, 8) = s3.Range("H7")
  s3.Range("H18").Value = s1.Cells(ss, "I")
  s3.Range("H19").Value = s1.Cells(ss, "W")
  ToplamSatırıBiçimlendirme
  s1.Range("A5:E" & sonsatir + 1).Select
    Selection.NumberFormat = "General"
   s1.Range("F5:H" & sonsatir + 1, "J5:W" & sonsatir + 1).Select
        Selection.NumberFormat = "#,##0.00"
   s1.Range("I5:I" & sonsatir + 1).Select
    Selection.NumberFormat = "#,##0.000"
s1.Range("E1").Select
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst