mucahitclk Mesaj tarihi: Mayıs 7, 2023 Mesaj tarihi: Mayıs 7, 2023 (düzenlendi) excel kodları aşagıdaki gibidir. kaydetmodu altında elseden sonra gelen kısımları nasıl becerdi isem silmişim. o kısım hakkında yardımcı olabilecek arkdaş varsa çok memnun olurum. kısaca form üzerinde değiştir, ekle, sil, ve formdaki verileri toplu olarak silmeme yarayan temizle butonu var. ekle butonu hariç diğer butonlar görevini gerçekleştiriyor ama ekle hiç bir işlem yapmıyor. kod dizisi modül altında aşağıdaki gibidir. Spoiler Option Explicit Dim adoCN As Object Dim RS As Object Dim ctr As Object Dim strSQL As String Dim strlog As String Dim data As String Dim DatabasePath As String Dim sor As String Dim simdi As String Dim i, X As Integer Dim T, L As Integer Dim sure(50) As Variant Dim kac As Double Dim sonyil As Integer Public Sub dateac(T, L) ecDate.Show End Sub Sub formac() Call DbAc: If adoCN.State <> 1 Then Exit Sub UserForm1.Show Call DbKapat End Sub Sub DbKontrol() Dim Yoll As String 'Yoll = Sheets("excelcozumleri").Range("d9").Value If Yoll = "" Then Yoll = ThisWorkbook.Path DatabasePath = Yoll & "\database.mdb" If Dir(DatabasePath) = "" Then On Error Resume Next MsgBox DatabasePath & " bulunamadı, programdan çıkılacak !", vbCritical, "www.excelcozumleri.com" Application.DisplayAlerts = False Application.Visible = True Application.Workbooks.Close End If End Sub Sub DbAc() Dim Yoll As String 'Yoll = Sheets("excelcozumleri").Range("d9").Value If Yoll = "" Then Yoll = ThisWorkbook.Path DatabasePath = Yoll & "\database.mdb" If Dir(DatabasePath) = "" Then MsgBox DatabasePath & " yolunda veritabanı bulunamadı !", vbCritical, "www.excelcozumleri.com" On Error Resume Next Set adoCN = CreateObject("ADODB.Connection") If Val(Application.Version) >= 12 Then If Val(Application.Version) >= 15 Then adoCN.Provider = "Microsoft.ACE.OLEDB." & Val(Application.Version) & ".0;Jet OLEDB:Database Password=-;" Else adoCN.Provider = "Microsoft.ACE.OLEDB.12.0;Jet OLEDB:Database Password=-;" End If Else adoCN.Provider = "Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=-;" End If adoCN.ConnectionString = DatabasePath adoCN.Open End Sub Sub DbAc_SQL() 'Dim songun As Date 'songun = "28.02.2017" 'If Date > songun Then Exit Sub On Error Resume Next Set adoCN = CreateObject("ADODB.Connection") adoCN.Open End Sub Sub DbKapat() '---------------Database kapanacak-------------- On Error Resume Next If adoCN.State = 1 Then adoCN.Close Else End End If End Sub Sub kaydet() Dim i As Integer Dim kaydetmodu As String Dim basliklar() Dim degerler(50) As Variant degerler(0) = UserForm1.Controls("TextBoxPerIDX").Value: If degerler(0) = "" Then Exit Sub degerler(1) = UserForm1.Controls("TextBox1").Value 'Call DbAc strlog = "Select personel.idx, personel.ad From personel Where personel.idx=" & degerler(0) Set RS = CreateObject("ADODB.recordset") RS.Open strlog, adoCN, 1 ', 3 'Set RS = adoCN.Execute(strlog) If RS.RecordCount > 0 Then sor = MsgBox("Var olan " & degerler(1) & " personel noya ait kayıt değiştirilecek." & Chr(10) & "Devam edeyim mi ?", vbYesNo + vbInformation + vbDefaultButton2, "Dikkat") If sor = vbNo Then Exit Sub kaydetmodu = "degistir" End If RS.Close Set RS = Nothing basliklar = Array("idx", "per_no", "ad", "soyad", "ilk_soyad", "tc_kimlik_no", "cinsiyet", "dogum_tarihi", "dogum_yeri", "baba_ad", "ana_ad", "ise_giris_tarihi", "is_cikis_tarihi", "hafta_tatili", "statu", "medeni_hali", "ssk_no", "dept", "gorev", "tahsil", "meslek", "ev_tel", "is_tel", "cep_tel", "eposta", "adres", "adres_il", "adres_ilce", "kan_grubu", "nfs_seri", "nfs_no", "nfs_kay_il", "nfs_kay_ilce", "nfs_kay_mah_koy", "cilt_no", "aile_sno", "sira_no", "aciklama") For i = 2 To 37 Select Case i Case 6, 13, 14, 15, 17, 18, 19, 28 degerler(i) = UserForm1.Controls("ComboBox" & i).Value Case Else degerler(i) = UserForm1.Controls("TextBox" & i) End Select Next i If degerler(1) = "" Or degerler(2) = "" Or degerler(3) = "" Then MsgBox "Personel No, Adı ve Soyadı boş olamaz..": Exit Sub If degerler(7) = "" Or degerler(11) = "" Then MsgBox "Doğum tarihi ve İşe Giriş tarihi boş olamaz..": Exit Sub If degerler(14) = "" Or degerler(17) = "" Then MsgBox "Statü ve Bölüm boş olamaz..": Exit Sub strlog = "Select personel.idx, personel.ad From personel Where personel.per_no='" & degerler(1) & "'" Set RS = CreateObject("ADODB.recordset") RS.Open strlog, adoCN, 1 ', 3 'Set RS = adoCN.Execute(strlog) If RS.RecordCount > 0 Then RS.MoveFirst Do While Not RS.EOF If RS("idx") <> Val(degerler(0)) Then MsgBox "Aynı Personel Numarası ile kayıtlı bir kişi var!": Exit Sub RS.MoveNext Loop End If RS.Close Set RS = Nothing If kaydetmodu = "degistir" Then strSQL = "UPDATE personel SET " & "personel." & basliklar(1) & " = '" & degerler(1) & "'" For i = 2 To 37 Select Case i Case 7, 11, 12 If degerler(i) = "" Then strSQL = strSQL & ", " & "personel." & basliklar(i) & " =NULL" Else strSQL = strSQL & ", " & "personel." & basliklar(i) & " = '" & degerler(i) & "'" End If Case Else strSQL = strSQL & ", " & "personel." & basliklar(i) & " = '" & degerler(i) & "'" End Select Next i strSQL = strSQL & " WHERE personel.idx=" & degerler(0) Else Bu kısım yok End If 'MsgBox strSQL On Error Resume Next adoCN.Execute (strSQL) 'Call DbKapat End Sub Sub list1show() Dim X As Integer Dim perbul, pasif, bolum As String UserForm1.ListBox1.Clear UserForm1.ListBox1.ColumnCount = 3 UserForm1.ListBox1.ColumnWidths = "45;130;0" 'Call DbAc perbul = UserForm1.Controls("TextBoxBUL").Value pasif = UserForm1.Controls("CheckBox10").Value bolum = UserForm1.Controls("SUZIZ1").Value strlog = "SELECT personel.idx, personel.per_no, personel.ad, personel.soyad FROM personel WHERE (personel.ad Like '%" & perbul & "%' OR personel.soyad Like '%" & perbul & "%') AND personel.idx<6" If pasif = False Then strlog = strlog & " AND personel.is_cikis_tarihi Is Null" If bolum <> "" And bolum <> "Tümü" Then strlog = strlog & " AND personel.dept = '" & bolum & "'" strlog = strlog & " ORDER BY personel.idx" 'Set RS = CreateObject("ADODB.recordset") 'RS.Open strlog, adoCN, 1 ', 3 Set RS = adoCN.Execute(strlog) 'If RS.RecordCount > 0 Then 'RS.Movefirst Do While Not RS.EOF X = X + 1 UserForm1.ListBox1.AddItem UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount - 1, 0) = RS("per_no") UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount - 1, 1) = RS("ad") & " " & RS("soyad") UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount - 1, 2) = RS("idx") RS.MoveNext Loop 'End If RS.Close Set RS = Nothing 'Call DbKapat End Sub Sub list3show() Dim X As Integer Dim Top_sure As Double Dim pernogetir, izturgetir, izyilgetir As String UserForm1.ListBox3.Clear UserForm1.ListBox3.ColumnCount = 7 UserForm1.ListBox3.ColumnWidths = "45;62;62;62;30;0;0" pernogetir = UserForm1.Controls("TextBoxPerIDX").Value: If pernogetir = "" Then Exit Sub izturgetir = UserForm1.Controls("SUZIZ2").Value izyilgetir = UserForm1.Controls("SUZIZ3").Value 'Call DbAc Top_sure = 0 strlog = "SELECT izinler.idx, izinler.tarih, izinler.per_idx, izinler.iz_basl, izinler.iz_bitis, izinler.ise_basl, izinler.sure, izinler.aciklama, izinler.izin_tur, year(iz_basl) AS iz_basl_yil FROM izinler WHERE (((izinler.per_idx) = " & pernogetir & ")" If izturgetir <> "" And izturgetir <> "Tümü" Then strlog = strlog & " And ((izinler.izin_tur) = '" & izturgetir & "')" If izyilgetir <> "" And izyilgetir <> "Tümü" Then strlog = strlog & " And ((year(iz_basl)) = '" & izyilgetir & "')" strlog = strlog & ") ORDER BY izinler.iz_basl DESC" 'Set RS = CreateObject("ADODB.recordset") 'RS.Open strlog, adoCN, 1 ', 3 Set RS = adoCN.Execute(strlog) 'If RS.RecordCount > 0 Then 'RS.Movefirst Do While Not RS.EOF X = X + 1 UserForm1.ListBox3.AddItem UserForm1.ListBox3.List(UserForm1.ListBox3.ListCount - 1, 0) = RS("izin_tur") UserForm1.ListBox3.List(UserForm1.ListBox3.ListCount - 1, 1) = Format(RS("iz_basl"), "Short Date") UserForm1.ListBox3.List(UserForm1.ListBox3.ListCount - 1, 2) = Format(RS("iz_bitis"), "Short Date") UserForm1.ListBox3.List(UserForm1.ListBox3.ListCount - 1, 3) = Format(RS("ise_basl"), "Short Date") 'RS("iz_bitis") UserForm1.ListBox3.List(UserForm1.ListBox3.ListCount - 1, 4) = Replace(RS("sure"), ".", ",") 'RS("iz_bitis") - RS("iz_basl") UserForm1.ListBox3.List(UserForm1.ListBox3.ListCount - 1, 5) = RS("idx") UserForm1.ListBox3.List(UserForm1.ListBox3.ListCount - 1, 6) = RS("aciklama") Top_sure = Top_sure + RS("sure") RS.MoveNext Loop 'End If RS.Close Set RS = Nothing UserForm1.Controls("Textbox48").Value = Replace(Top_sure, ".", ",") 'Call DbKapat End Sub Sub list4show() Dim X As Integer Dim perbul, pasif, bolum As String Dim Top_sure, top_kullanilan As Double Dim son As Date UserForm1.ListBox4.Clear UserForm1.ListBox4.ColumnCount = 9 UserForm1.ListBox4.ColumnWidths = "45;110;140;90;65;65;65;45;0" 'Call DbAc perbul = "" 'UserForm1.Controls("TextBoxBUL").Value pasif = UserForm1.Controls("CheckBox11").Value bolum = UserForm1.Controls("SUZIZ4").Value strlog = "SELECT personel.idx, personel.per_no, personel.ad, personel.soyad, personel.statu, personel.gorev, personel.dept, personel.dogum_tarihi, personel.ise_giris_tarihi, personel.is_cikis_tarihi, a.Toplasure" strlog = strlog & " FROM personel LEFT JOIN (SELECT personel.idx, izinler.izin_tur, Sum(izinler.sure) AS Toplasure FROM izinler INNER JOIN personel ON izinler.per_idx = personel.idx GROUP BY personel.idx, izinler.izin_tur HAVING (((izinler.izin_tur)='Yıllık'))) AS a ON personel.idx = a.idx" strlog = strlog & " WHERE personel.ad <> ''" If pasif = False Then strlog = strlog & " AND personel.is_cikis_tarihi Is Null" If bolum <> "" And bolum <> "Tümü" Then strlog = strlog & " AND personel.dept = '" & bolum & "'" strlog = strlog & " ORDER BY personel.idx" 'Set RS = CreateObject("ADODB.recordset") 'RS.Open strlog, adoCN, 1 ', 3 Set RS = adoCN.Execute(strlog) 'If RS.RecordCount > 0 Then 'RS.Movefirst Do While Not RS.EOF 'X = X + 1 UserForm1.ListBox4.AddItem UserForm1.ListBox4.List(UserForm1.ListBox4.ListCount - 1, 0) = RS("per_no") UserForm1.ListBox4.List(UserForm1.ListBox4.ListCount - 1, 1) = RS("ad") & " " & RS("soyad") UserForm1.ListBox4.List(UserForm1.ListBox4.ListCount - 1, 2) = RS("dept") If IsNull(RS("gorev")) = False Then UserForm1.ListBox4.List(UserForm1.ListBox4.ListCount - 1, 3) = RS("gorev") UserForm1.ListBox4.List(UserForm1.ListBox4.ListCount - 1, 4) = Format(RS("dogum_tarihi"), "Short Date") UserForm1.ListBox4.List(UserForm1.ListBox4.ListCount - 1, 5) = Format(RS("ise_giris_tarihi"), "Short Date") If IsNull(RS("is_cikis_tarihi")) = False Then UserForm1.ListBox4.List(UserForm1.ListBox4.ListCount - 1, 6) = Format(RS("is_cikis_tarihi"), "Short Date") If IsNull(RS("is_cikis_tarihi")) = True Then son = Date Else son = RS("is_cikis_tarihi") If IsNull(RS("Toplasure")) = True Then top_kullanilan = 0 Else top_kullanilan = RS("Toplasure") Top_sure = IzinHesapla(RS("ise_giris_tarihi"), son, RS("dogum_tarihi"), RS("statu")) - top_kullanilan UserForm1.ListBox4.List(UserForm1.ListBox4.ListCount - 1, 7) = Replace(Top_sure, ".", ",") UserForm1.ListBox4.List(UserForm1.ListBox4.ListCount - 1, = RS("idx") RS.MoveNext Loop 'End If RS.Close Set RS = Nothing 'Call DbKapat End Sub Sub list7show() Dim perbul, pasif, combotur As String UserForm1.ListBox7.Clear UserForm1.ListBox7.ColumnCount = 2 UserForm1.ListBox7.ColumnWidths = "130;0" 'Call DbAc 'pasif = UserForm1.Controls("CheckBox10").Value combotur = UserForm1.Controls("COMBOSUZ").Value strlog = "SELECT * FROM combodoldur WHERE combodoldur.combo_tur = '" & combotur & "'" strlog = strlog & " ORDER BY combodoldur.idx" 'Set RS = CreateObject("ADODB.recordset") 'RS.Open strlog, adoCN, 1 ', 3 Set RS = adoCN.Execute(strlog) 'If RS.RecordCount > 0 Then 'RS.Movefirst UserForm1.Controls("TextBoxCOMNO").Value = RS("combo_no") Do While Not RS.EOF UserForm1.ListBox7.AddItem UserForm1.ListBox7.List(UserForm1.ListBox7.ListCount - 1, 0) = RS("deger") UserForm1.ListBox7.List(UserForm1.ListBox7.ListCount - 1, 1) = RS("idx") RS.MoveNext Loop 'End If RS.Close Set RS = Nothing 'Call DbKapat End Sub Sub list6show() Dim X As Integer Dim Top_sure As Double Dim baynogetir, bayyilgetir As String UserForm1.ListBox6.Clear UserForm1.ListBox6.ColumnCount = 4 UserForm1.ListBox6.ColumnWidths = "62;190;30;0" baynogetir = UserForm1.Controls("TextBoxBAYIDX").Value 'bayyilgetir = UserForm1.Controls("SUZIZ2").Value 'Call DbAc strlog = "SELECT bayramlar.idx, bayramlar.tarih, bayramlar.aciklama, bayramlar.gun, year(tarih) AS yil FROM bayramlar" 'If bayyilgetir <> "" And bayyilgetir <> "Tümü" Then strlog = strlog & " WHERE bayramlar.yil = '" & bayyilgetir & "'" strlog = strlog & " ORDER BY bayramlar.tarih DESC" 'Set RS = CreateObject("ADODB.recordset") 'RS.Open strlog, adoCN, 1 ', 3 Set RS = adoCN.Execute(strlog) 'If RS.RecordCount > 0 Then 'RS.Movefirst Do While Not RS.EOF X = X + 1 UserForm1.ListBox6.AddItem UserForm1.ListBox6.List(UserForm1.ListBox6.ListCount - 1, 0) = Format(RS("tarih"), "Short Date") UserForm1.ListBox6.List(UserForm1.ListBox6.ListCount - 1, 1) = RS("aciklama") UserForm1.ListBox6.List(UserForm1.ListBox6.ListCount - 1, 2) = Replace(RS("gun"), ".", ",") UserForm1.ListBox6.List(UserForm1.ListBox6.ListCount - 1, 3) = RS("idx") RS.MoveNext Loop 'End If RS.Close Set RS = Nothing 'Call DbKapat End Sub Sub getir() On Local Error Resume Next Dim idxgetir, kac As Integer X = UserForm1.ListBox1.ListIndex idxgetir = UserForm1.ListBox1.List(UserForm1.ListBox1.ListIndex, 2) If idxgetir > 0 Then Else Exit Sub 'Call DbAc strlog = "Select * From personel Where personel.idx=" & idxgetir 'Set RS = CreateObject("ADODB.recordset") 'RS.Open strlog, adoCN, 1 ', 3 Set RS = adoCN.Execute(strlog) 'If RS.RecordCount > 0 Then 'RS.Movefirst For i = 1 To 40 Select Case i Case 6, 13, 14, 15, 17, 18, 19, 28 UserForm1.Controls("ComboBox" & i).Value = RS(i) Case 7, 11, 12 UserForm1.Controls("TextBox" & i).Value = Format(RS(i), "Short Date") Case Else UserForm1.Controls("TextBox" & i).Value = RS(i) End Select Next i 'End If UserForm1.Controls("TextBoxPerIDX").Value = RS(0) RS.Close Set RS = Nothing '-------------------- 'Call DbKapat End Sub Sub izingetir() On Local Error Resume Next Dim idxgetir, kac As Integer X = UserForm1.ListBox3.ListIndex idxgetir = UserForm1.ListBox3.List(UserForm1.ListBox3.ListIndex, 5) If idxgetir > 0 Then Else Exit Sub 'Call DbAc strlog = "Select * From izinler Where izinler.idx=" & idxgetir 'Set RS = CreateObject("ADODB.recordset") 'RS.Open strlog, adoCN, 1 ', 3 Set RS = adoCN.Execute(strlog) 'If RS.RecordCount > 0 Then 'RS.Movefirst UserForm1.Controls("ComboBox41").Value = RS("izin_tur") UserForm1.Controls("TextBox42").Value = Format(RS("iz_basl"), "Short Date") UserForm1.Controls("TextBox43").Value = Replace(RS("sure"), ".", ",") UserForm1.Controls("TextBox44").Value = Replace(RS("yol_izni"), ".", ",") UserForm1.Controls("TextBox45").Value = RS("iz_bul_adres") UserForm1.Controls("TextBox46").Value = RS("aciklama") 'End If UserForm1.Controls("TextBoxIzIDX").Value = idxgetir RS.Close Set RS = Nothing '-------------------- 'Call DbKapat End Sub Sub combogetir() On Local Error Resume Next Dim idxgetir, kac As Integer idxgetir = UserForm1.ListBox7.List(UserForm1.ListBox7.ListIndex, 1) If idxgetir > 0 Then Else Exit Sub 'Call DbAc strlog = "Select * From combodoldur Where combodoldur.idx=" & idxgetir 'Set RS = CreateObject("ADODB.recordset") 'RS.Open strlog, adoCN, 1 ', 3 Set RS = adoCN.Execute(strlog) 'If RS.RecordCount > 0 Then 'RS.Movefirst UserForm1.Controls("TextBox61").Value = RS("deger") 'End If UserForm1.Controls("TextBoxCOMIDX").Value = idxgetir RS.Close Set RS = Nothing '-------------------- 'Call DbKapat End Sub Sub bayramgetir() On Local Error Resume Next Dim idxgetir, kac As Integer idxgetir = UserForm1.ListBox6.List(UserForm1.ListBox6.ListIndex, 3) If idxgetir > 0 Then Else Exit Sub 'Call DbAc strlog = "Select * From bayramlar Where bayramlar.idx=" & idxgetir 'Set RS = CreateObject("ADODB.recordset") 'RS.Open strlog, adoCN, 1 ', 3 Set RS = adoCN.Execute(strlog) 'If RS.RecordCount > 0 Then 'RS.Movefirst UserForm1.Controls("TextBox71").Value = Format(RS("tarih"), "Short Date") UserForm1.Controls("TextBox72").Value = RS("aciklama") UserForm1.Controls("TextBox73").Value = Replace(RS("gun"), ".", ",") 'End If UserForm1.Controls("TextBoxBAYIDX").Value = idxgetir RS.Close Set RS = Nothing '-------------------- 'Call DbKapat End Sub Sub nobul() On Local Error Resume Next 'Call DbAc strlog = "SELECT Max(personel.[idx]) AS EnÇokNo FROM personel" 'Set RS = CreateObject("ADODB.recordset") 'RS.Open strlog, adoCN, 1 ', 3 Set RS = adoCN.Execute(strlog) If IsNull(RS("EnÇokNo")) = True Then UserForm1.Controls("TextBoxPerIDX").Value = 1 Else UserForm1.Controls("TextBoxPerIDX").Value = RS("EnÇokNo") + 1 End If RS.Close Set RS = Nothing 'Call DbKapat End Sub Sub kayitsil() On Local Error Resume Next Dim nosil As Integer Dim perno As String nosil = UserForm1.Controls("TextBoxPerIDX").Value perno = UserForm1.Controls("TextBox1").Value sor = MsgBox(perno & " personel nolu kayıt tüm izin geçmişi ile silinecek. " & Chr(10) & "Devam edeyim mi ?", vbYesNo + vbCritical + vbDefaultButton2, "Dikkat") If sor = vbNo Then Exit Sub 'Call DbAc strlog = "DELETE FROM personel WHERE personel.idx=" & nosil adoCN.Execute (strlog) strlog = "DELETE FROM izinler WHERE izinler.per_idx=" & nosil adoCN.Execute (strlog) 'Call DbKapat End Sub '********************************************************************************************* Sub IZkaydet() Dim i, k, nobul, b As Integer Dim strSQL, strlog, kaydetmodu, statu, haftatatili As String Dim bitis As Double Dim degerler(20), bayramlar(15), gun(15) As Variant Dim basliklar() Dim tempdate, basl, ise_basl As Date basl = Date: bitis = 0 degerler(0) = UserForm1.Controls("TextBoxIzIDX").Value: If degerler(0) = "" Then Exit Sub degerler(1) = UserForm1.Controls("TextBoxPerIDX").Value: If degerler(1) = "" Then Exit Sub degerler(2) = Format(Date, "Short Date") statu = UserForm1.Controls("ComboBox14").Value haftatatili = UserForm1.Controls("ComboBox13").Value 'Call DbAc strlog = "Select izinler.idx, izinler.per_idx From izinler Where izinler.idx=" & degerler(0) Set RS = CreateObject("ADODB.recordset") RS.Open strlog, adoCN, 1 ', 3 'Set RS = adoCN.Execute(strlog) If RS.RecordCount > 0 Then sor = MsgBox("Var olan izin kaydı değiştirilecek. Devam edeyim mi ?", vbYesNo + vbInformation + vbDefaultButton2, "Dikkat") If sor = vbNo Then Exit Sub kaydetmodu = "degistir" End If RS.Close Set RS = Nothing basliklar = Array("idx", "per_idx", "tarih", "izin_tur", "iz_basl", "iz_bitis", "ise_basl", "sure", "yol_izni", "iz_bul_adres", "aciklama") On Error Resume Next For i = 3 To 10 Select Case i Case 3 degerler(i) = UserForm1.Controls("ComboBox" & i + 38).Value Case 4 degerler(i) = Format(UserForm1.Controls("TextBox" & i + 38).Value, "Short Date") Case 5, 6 Case 7, 8 degerler(i) = Replace(UserForm1.Controls("TextBox" & i + 36).Value, ".", ",") Case Else degerler(i) = UserForm1.Controls("TextBox" & i + 36).Value End Select Next i basl = Format(UserForm1.Controls("TextBox42").Value, "Short Date") If basl = "" Or degerler(7) = "" Then MsgBox "İzin başlangıç tarihi ve İzin süresi boş olamaz..": Exit Sub If degerler(8) = "" Then degerler(8) = 0 '****************İzin bitiş hesaplama****************** strlog = "SELECT bayramlar.tarih, bayramlar.gun FROM bayramlar WHERE (((bayramlar.tarih)>=#" & Month(basl) & "/" & Day(basl) & "/" & Year(basl) & "# And (bayramlar.tarih) Is Not Null))" 'Set RS = CreateObject("ADODB.recordset") 'RS.Open strlog, adoCN, 1 ', 3 Set RS = adoCN.Execute(strlog) 'If RS.RecordCount > 0 Then 'RS.Movefirst Do While Not RS.EOF bayramlar(b) = Format(RS("tarih"), "Short Date") gun(b) = RS("gun") b = b + 1 RS.MoveNext Loop 'End If RS.Close Set RS = Nothing tempdate = DateAdd("d", 0, basl) For i = 1 To CDbl(degerler(7)) + CDbl(degerler(8)) + 1 If statu = "Memur" Or degerler(3) <> "Yıllık" Then GoTo gec Select Case DatePart("w", tempdate, vbMonday) Case 7 If haftatatili = "" Then i = i - 1: GoTo izinsonu If haftatatili Like "*Pazar" Or haftatatili Like "*Haftasonu*" Then i = i - 1: GoTo izinsonu Case 6 If statu = "Memur" And haftatatili = "" Then i = i - 1: GoTo izinsonu If haftatatili Like "*Cumartesi*" Or haftatatili Like "*Haftasonu*" Then i = i - 1: GoTo izinsonu Case 5 If haftatatili Like "*Cuma" Then i = i - 1: GoTo izinsonu Case 4 If haftatatili Like "*Perşembe*" Then i = i - 1: GoTo izinsonu Case 3 If haftatatili Like "*Çarşamba*" Then i = i - 1: GoTo izinsonu Case 2 If haftatatili Like "*Salı*" Then i = i - 1: GoTo izinsonu Case 1 If haftatatili Like "*Pazartesi*" Then i = i - 1: GoTo izinsonu Case Else End Select For b = 0 To 15 If tempdate = CDate(bayramlar(b)) Then i = i - gun(b) Exit For End If Next b gec: If i >= CDbl(degerler(7)) + CDbl(degerler(8)) And bitis = 0 Then bitis = tempdate izinsonu: tempdate = DateAdd("d", 1, tempdate) Next i ise_basl = DateAdd("d", -1, tempdate) degerler(5) = Format(bitis, "Short Date") degerler(6) = Format(ise_basl, "Short Date") '************************************************************** 'strlog = "SELECT izinler.idx, izinler.per_idx, izinler.iz_basl, izinler.ise_basl FROM izinler WHERE izinler.iz_basl<=#" & Month(degerler(4)) & "/" & Day(degerler(4)) & "/" & Year(degerler(4)) & "# And izinler.ise_basl>#" & Month(degerler(4)) & "/" & Day(degerler(4)) & "/" & Year(degerler(4)) & "# And izinler.per_idx=" & degerler(1) strlog = "SELECT izinler.idx, izinler.per_idx, izinler.iz_basl, izinler.ise_basl FROM izinler" strlog = strlog & " WHERE (izinler.ise_basl>#" & Month(degerler(4)) & "/" & Day(degerler(4)) & "/" & Year(degerler(4)) & "# AND izinler.iz_basl<#" & Month(degerler(6)) & "/" & Day(degerler(6)) & "/" & Year(degerler(6)) & "#)" strlog = strlog & " AND izinler.per_idx=" & degerler(1) Set RS = CreateObject("ADODB.recordset") RS.Open strlog, adoCN, 1 ', 3 'Set RS = adoCN.Execute(strlog) If RS.RecordCount > 0 Then RS.MoveFirst Do While Not RS.EOF If RS("idx") <> Val(degerler(0)) Then MsgBox "Personel bu tarihte zaten izinde gözüküyor..": Exit Sub RS.MoveNext Loop End If RS.Close Set RS = Nothing '*************************************************************** If kaydetmodu = "degistir" Then strSQL = "UPDATE izinler SET " & "izinler." & basliklar(1) & " = " & degerler(1) For i = 2 To 10 Select Case i Case 2, 4, 5, 6 If degerler(i) = "" Then strSQL = strSQL & ", " & "izinler." & basliklar(i) & " =NULL" Else strSQL = strSQL & ", " & "izinler." & basliklar(i) & " = '" & degerler(i) & "'" End If Case 7, 8 If degerler(i) = "" Then degerler(i) = 0 strSQL = strSQL & ", " & "izinler." & basliklar(i) & " = " & Replace(CDbl(degerler(i)), ",", ".") Case Else strSQL = strSQL & ", " & "izinler." & basliklar(i) & " = '" & Replace(degerler(i), "'", "") & "'" End Select Next i strSQL = strSQL & " WHERE izinler.idx=" & degerler(0) Else strSQL = "INSERT INTO izinler (" & basliklar(0) For i = 1 To 10 strSQL = strSQL & ", " & basliklar(i) Next i strSQL = strSQL & ") VALUES (" & degerler(0) For i = 1 To 10 Select Case i Case 2, 4, 5, 6 If degerler(i) = "" Then strSQL = strSQL & ",NULL" Else strSQL = strSQL & ", '" & degerler(i) & "'" End If Case 7, 8 If degerler(i) = "" Then degerler(i) = 0 strSQL = strSQL & ", " & Replace(CDbl(degerler(i)), ",", ".") Case Else strSQL = strSQL & ", '" & Replace(degerler(i), "'", "") & "'" End Select Next i strSQL = strSQL & ")" End If On Error Resume Next adoCN.Execute (strSQL) 'Call DbKapat End Sub Sub IZkayitsil() On Local Error Resume Next Dim nosil As Integer nosil = UserForm1.Controls("TextBoxIzIDX").Value sor = MsgBox("İzin kaydı silinecek. Devam edeyim mi ?", vbYesNo + vbCritical + vbDefaultButton2, "Dikkat") If sor = vbNo Then Exit Sub 'Call DbAc strlog = "DELETE FROM izinler WHERE izinler.idx=" & nosil adoCN.Execute (strlog) 'Call DbKapat End Sub Sub IZnobul() On Local Error Resume Next 'Call DbAc strlog = "SELECT Max(izinler.[idx]) AS EnÇokNo FROM izinler" 'Set RS = CreateObject("ADODB.recordset") 'RS.Open strlog, adoCN, 1 ', 3 Set RS = adoCN.Execute(strlog) If IsNull(RS("EnÇokNo")) = True Then UserForm1.Controls("TextBoxIzIDX").Value = 1 Else UserForm1.Controls("TextBoxIzIDX").Value = RS("EnÇokNo") + 1 End If RS.Close Set RS = Nothing 'Call DbKapat End Sub Sub COMkaydet() Dim i As Integer Dim kaydetmodu As String Dim basliklar() Dim degerler(50) As Variant degerler(0) = UserForm1.Controls("TextBoxCOMIDX").Value: If degerler(0) = "" Then Exit Sub degerler(1) = UserForm1.Controls("TextBoxCOMNO").Value: If degerler(1) = "" Then Exit Sub 'Call DbAc strlog = "Select combodoldur.idx, combodoldur.deger From combodoldur Where combodoldur.idx=" & degerler(0) Set RS = CreateObject("ADODB.recordset") RS.Open strlog, adoCN, 1 ', 3 'Set RS = adoCN.Execute(strlog) If RS.RecordCount > 0 Then sor = MsgBox("Var olan " & RS(1) & " değeri değiştirilecek." & Chr(10) & "Devam edeyim mi ?", vbYesNo + vbInformation + vbDefaultButton2, "Dikkat") If sor = vbNo Then Exit Sub kaydetmodu = "degistir" End If RS.Close Set RS = Nothing basliklar = Array("idx", "combo_no", "deger", "combo_tur") For i = 2 To 3 Select Case i Case 3 degerler(i) = UserForm1.Controls("COMBOSUZ").Value Case Else degerler(i) = UserForm1.Controls("TextBox" & i + 59) End Select Next i If kaydetmodu = "degistir" Then strSQL = "UPDATE combodoldur SET " & "combodoldur." & basliklar(1) & " = '" & degerler(1) & "'" For i = 2 To 3 strSQL = strSQL & ", " & "combodoldur." & basliklar(i) & " = '" & degerler(i) & "'" Next i strSQL = strSQL & " WHERE combodoldur.idx=" & degerler(0) Else strSQL = "INSERT INTO combodoldur (" & basliklar(0) For i = 1 To 3 strSQL = strSQL & ", " & basliklar(i) Next i strSQL = strSQL & ") VALUES (" & degerler(0) For i = 1 To 3 strSQL = strSQL & ", '" & degerler(i) & "'" Next i strSQL = strSQL & ")" End If 'MsgBox strSQL On Error Resume Next adoCN.Execute (strSQL) 'Call DbKapat End Sub Sub COMkayitsil() On Local Error Resume Next Dim nosil As Integer nosil = UserForm1.Controls("TextBoxCOMIDX").Value sor = MsgBox("Açılan kutu kaydı silinecek. Devam edeyim mi ?", vbYesNo + vbCritical + vbDefaultButton2, "Dikkat") If sor = vbNo Then Exit Sub 'Call DbAc strlog = "DELETE FROM combodoldur WHERE combodoldur.idx=" & nosil adoCN.Execute (strlog) 'Call DbKapat End Sub Sub COMnobul() On Local Error Resume Next 'Call DbAc strlog = "SELECT Max(combodoldur.[idx]) AS EnÇokNo FROM combodoldur" 'Set RS = CreateObject("ADODB.recordset") 'RS.Open strlog, adoCN, 1 ', 3 Set RS = adoCN.Execute(strlog) If IsNull(RS("EnÇokNo")) = True Then UserForm1.Controls("TextBoxCOMIDX").Value = 1 Else UserForm1.Controls("TextBoxCOMIDX").Value = RS("EnÇokNo") + 1 End If RS.Close Set RS = Nothing 'Call DbKapat End Sub Sub BAYkaydet() Dim i, k, nobul, b As Integer Dim strSQL, strlog, kaydetmodu, statu, haftatatili As String Dim bitis As Double Dim degerler(20), bayramlar(15), gun(15) As Variant Dim basliklar() Dim tempdate, basl, ise_basl As Date degerler(0) = UserForm1.Controls("TextBoxBAYIDX").Value: If degerler(0) = "" Then Exit Sub 'Call DbAc strlog = "Select bayramlar.idx, bayramlar.aciklama From bayramlar Where bayramlar.idx=" & degerler(0) Set RS = CreateObject("ADODB.recordset") RS.Open strlog, adoCN, 1 ', 3 'Set RS = adoCN.Execute(strlog) If RS.RecordCount > 0 Then sor = MsgBox("Var olan " & RS(1) & " bayram kaydı değiştirilecek. Devam edeyim mi ?", vbYesNo + vbInformation + vbDefaultButton2, "Dikkat") If sor = vbNo Then Exit Sub kaydetmodu = "degistir" End If RS.Close Set RS = Nothing basliklar = Array("idx", "tarih", "aciklama", "gun") On Error Resume Next For i = 1 To 3 Select Case i Case 1 degerler(i) = Format(UserForm1.Controls("TextBox" & i + 70).Value, "Short Date") Case 3 degerler(i) = Replace(UserForm1.Controls("TextBox" & i + 70).Value, ".", ",") Case Else degerler(i) = UserForm1.Controls("TextBox" & i + 70).Value End Select Next i If degerler(1) = "" Then MsgBox "Tarih boş olamaz..": Exit Sub If degerler(3) = "" Then degerler(3) = 1 If kaydetmodu = "degistir" Then strSQL = "UPDATE bayramlar SET " & "bayramlar." & basliklar(1) & " = '" & degerler(1) & "'" For i = 2 To 3 Select Case i Case 1 If degerler(i) = "" Then strSQL = strSQL & ", " & "bayramlar." & basliklar(i) & " =NULL" Else strSQL = strSQL & ", " & "bayramlar." & basliklar(i) & " = '" & degerler(i) & "'" End If Case 3 If degerler(i) = "" Then degerler(i) = 0 strSQL = strSQL & ", " & "bayramlar." & basliklar(i) & " = " & Replace(CDbl(degerler(i)), ",", ".") Case Else strSQL = strSQL & ", " & "bayramlar." & basliklar(i) & " = '" & degerler(i) & "'" End Select Next i strSQL = strSQL & " WHERE bayramlar.idx=" & degerler(0) Else strSQL = "INSERT INTO bayramlar (" & basliklar(0) For i = 1 To 3 strSQL = strSQL & ", " & basliklar(i) Next i strSQL = strSQL & ") VALUES (" & degerler(0) For i = 1 To 3 Select Case i Case 1 If degerler(i) = "" Then strSQL = strSQL & ",NULL" Else strSQL = strSQL & ", '" & degerler(i) & "'" End If Case 3 If degerler(i) = "" Then degerler(i) = 0 strSQL = strSQL & ", " & Replace(CDbl(degerler(i)), ",", ".") Case Else strSQL = strSQL & ", '" & degerler(i) & "'" End Select Next i strSQL = strSQL & ")" End If 'MsgBox strSQL On Error Resume Next adoCN.Execute (strSQL) 'Call DbKapat End Sub Sub BAYkayitsil() On Local Error Resume Next Dim nosil As Integer nosil = UserForm1.Controls("TextBoxBAYIDX").Value sor = MsgBox("Seçili bayram kaydı silinecek. Devam edeyim mi ?", vbYesNo + vbCritical + vbDefaultButton2, "Dikkat") If sor = vbNo Then Exit Sub 'Call DbAc strlog = "DELETE FROM bayramlar WHERE bayramlar.idx=" & nosil adoCN.Execute (strlog) 'Call DbKapat End Sub Sub BAYnobul() On Local Error Resume Next 'Call DbAc strlog = "SELECT Max(bayramlar.[idx]) AS EnÇokNo FROM bayramlar" 'Set RS = CreateObject("ADODB.recordset") 'RS.Open strlog, adoCN, 1 ', 3 Set RS = adoCN.Execute(strlog) If IsNull(RS("EnÇokNo")) = True Then UserForm1.Controls("TextBoxBAYIDX").Value = 1 Else UserForm1.Controls("TextBoxBAYIDX").Value = RS("EnÇokNo") + 1 End If RS.Close Set RS = Nothing 'Call DbKapat End Sub Sub list2show() Dim X, i, hakyili As Integer 'Dim sure(50) As Variant Dim Top_sure, top_kul_yil As Double Dim ilk As Date Dim son As Date 'Dim sonyilgirisgunu As Date Dim dogumtar As Date Dim haktarihi As Date Dim pernogetir, statu As String On Error Resume Next UserForm1.ListBox2.Clear UserForm1.ListBox2.ColumnCount = 3 UserForm1.ListBox2.ColumnWidths = "33;62;30" ilk = UserForm1.Controls("TextBox11").Value: If UserForm1.Controls("TextBox11").Value = "" Then Exit Sub son = UserForm1.Controls("TextBox12").Value: If UserForm1.Controls("TextBox12").Value = "" Then son = Date dogumtar = UserForm1.Controls("TextBox7").Value: If UserForm1.Controls("TextBox7").Value = "" Then Exit Sub statu = UserForm1.Controls("ComboBox14").Value 'sonyilgirisgunu = Format(Day(ilk) & "." & Month(ilk) & "." & Year(son), "dd.mm.yyyy") 'sonyil = Val(Year(son)): If son < sonyilgirisgunu Then sonyil = sonyil - 1 'kac = Application.WorksheetFunction.RoundDown((son - ilk) / 365.25, 0) pernogetir = UserForm1.Controls("TextBoxPerIDX").Value If pernogetir = "" Then Exit Sub 'Call DbAc strlog = "SELECT izinler.per_idx, izinler.izin_tur, Sum(izinler.sure) AS Toplasure FROM izinler GROUP BY izinler.per_idx, izinler.izin_tur HAVING (((izinler.per_idx)=" & pernogetir & ") AND ((izinler.izin_tur)='Yıllık'))" Set RS = CreateObject("ADODB.recordset") RS.Open strlog, adoCN, 1 ', 3 'Set RS = adoCN.Execute(strlog) If RS.RecordCount > 0 Then RS.MoveFirst Do While Not RS.EOF top_kul_yil = RS("Toplasure") RS.MoveNext Loop End If Top_sure = IzinHesapla(ilk, son, dogumtar, statu) - top_kul_yil UserForm1.Controls("TextBox47").Value = Replace(Top_sure, ".", ",") X = 1 Do While Top_sure > 0 And IsEmpty(sure(kac - X + 1)) = False If sure(kac - X + 1) > Top_sure Then sure(kac - X + 1) = Top_sure If statu = "Memur" And kac - X + 1 > 1 Then haktarihi = Format("01" & "/" & "01" & "/" & sonyil - X + 1, "Short Date") Else haktarihi = Format(Day(ilk) & "/" & Month(ilk) & "/" & sonyil - X + 1, "Short Date") End If If statu = "Memur" Then hakyili = sonyil - X + 1 Else hakyili = sonyil - X UserForm1.ListBox2.AddItem UserForm1.ListBox2.List(UserForm1.ListBox2.ListCount - 1, 0) = hakyili 'sonyil - X + 1 UserForm1.ListBox2.List(UserForm1.ListBox2.ListCount - 1, 1) = Format(haktarihi, "Short Date") 'Format(Day(ilk) & "/" & Month(ilk) & "/" & sonyil - X + 1, "Short Date") UserForm1.ListBox2.List(UserForm1.ListBox2.ListCount - 1, 2) = Replace(sure(kac - X + 1), ".", ",") Top_sure = Top_sure - sure(kac - X + 1) X = X + 1 Loop RS.Close Set RS = Nothing 'Call DbKapat End Sub Function IzinHesapla(ilk As Date, son As Date, dogumtar As Date, statu As String) 'Dim sonyil As Integer 'Dim sure(50) As Variant Dim Top_sure As Double Dim oyılgiristar As Date Dim sonyilgirisgunu As Date If statu = "Memur" Then son = Format("31" & "/" & "12" & "/" & Year(son), "dd/mm/yyyy") sonyilgirisgunu = Format(Day(ilk) & "/" & Month(ilk) & "/" & Year(son), "dd/mm/yyyy") sonyil = Val(Year(son)): If son < sonyilgirisgunu Then sonyil = sonyil - 1 kac = Application.WorksheetFunction.RoundDown((son - ilk) / 365.25, 0) For i = 1 To kac 'burası değişince izin makrosunda da düzelt oyılgiristar = Format(Day(ilk) & "/" & Month(ilk) & "/" & sonyil - kac + i, "dd/mm/yyyy") Select Case statu Case "Memur" Select Case i Case 1 To 5 sure(i) = 20 'memurlarda 20 If oyılgiristar <= DateAdd("yyyy", 18, dogumtar) Or oyılgiristar >= DateAdd("yyyy", 50, dogumtar) Then sure(i) = 20 Case 6 To 9 sure(i) = 20 'memurlarda 20 Case 10 To 14 sure(i) = 30 'memurlarda 30 Case Is > 14 sure(i) = 30 'memurlarda 30 End Select Case "Sendikali" Select Case i Case 1 To 5 sure(i) = 22 'If oyılgiristar <= DateAdd("yyyy", 18, dogumtar) Or oyılgiristar >= DateAdd("yyyy", 50, dogumtar) Then sure(i) = 20 Case 6 To 9 sure(i) = 28 Case 10 To 14 sure(i) = 30 Case Is > 14 sure(i) = 30 End Select Case Else Select Case i Case 1 To 5 If oyılgiristar >= "10/06/2003" Then sure(i) = 14 Else sure(i) = 12 'işçilerde 14 (5/5/2006 öncesi 18 idi) If oyılgiristar <= DateAdd("yyyy", 18, dogumtar) Or oyılgiristar >= DateAdd("yyyy", 50, dogumtar) Then sure(i) = 20 Case 6 To 10 If oyılgiristar >= "10/06/2003" Then sure(i) = 20 Else sure(i) = 18 'işçilerde 20 (5/5/2006 öncesi 22 idi) If oyılgiristar <= DateAdd("yyyy", 18, dogumtar) Or oyılgiristar >= DateAdd("yyyy", 50, dogumtar) Then sure(i) = 20 Case 11 To 14 If oyılgiristar >= "10/06/2003" Then sure(i) = 20 Else sure(i) = 18 'işçilerde 20 (5/5/2006 öncesi 22 idi) If oyılgiristar <= DateAdd("yyyy", 18, dogumtar) Or oyılgiristar >= DateAdd("yyyy", 50, dogumtar) Then sure(i) = 20 Case Is > 14 If oyılgiristar >= "10/06/2003" Then sure(i) = 26 Else sure(i) = 24 End Select End Select Top_sure = Top_sure + sure(i) Next i IzinHesapla = Top_sure End Function Sub resim() Dim myPict As Picture Dim perno, sFile, sPath, Kontrol As String Dim Yoll As String 'Yoll = Sheets("excelcozumleri").Range("d9").Value If Yoll = "" Then Yoll = ThisWorkbook.Path 'VBAProject.ThisWorkbook.Path perno = UserForm1.Controls("TextBox1").Value On Error Resume Next If perno = "" Then Exit Sub sFile = perno & ".jpg" sPath = Yoll & "\PersonelResimleri\" & sFile Kontrol = Dir(sPath) If Kontrol = "" Then sPath = Yoll & "\PersonelResimleri\" & "no_image.jpg" 'VBAProject.ThisWorkbook.Path On Error Resume Next UserForm1.Image1.Picture = LoadPicture(sPath) End Sub Sub ComboyaVeriler() On Local Error Resume Next UserForm1.ComboBox6.Clear: UserForm1.ComboBox14.Clear: UserForm1.ComboBox15.Clear: UserForm1.ComboBox28.Clear: UserForm1.ComboBox19.Clear: UserForm1.ComboBox41.Clear UserForm1.ComboBox17.Clear: UserForm1.ComboBox18.Clear: UserForm1.SUZIZ1.Clear: UserForm1.SUZIZ4.Clear: UserForm1.COMBOSUZ.Clear 'Call DbAc strlog = "SELECT combodoldur.idx, combodoldur.combo_no, combodoldur.deger FROM combodoldur ORDER BY combodoldur.idx" 'Set RS = CreateObject("ADODB.recordset") 'RS.Open strlog, adoCN, 1 ', 3 Set RS = adoCN.Execute(strlog) 'If RS.RecordCount > 0 Then 'RS.Movefirst Do While Not RS.EOF If RS("deger") <> "" Then UserForm1.Controls("ComboBox" & RS("combo_no")).AddItem RS("deger") RS.MoveNext Loop 'End If 'RS.Close 'Set RS = Nothing strlog = "SELECT combodoldur.idx, personel.dept FROM personel LEFT JOIN combodoldur ON personel.dept = combodoldur.deger GROUP BY combodoldur.idx, personel.dept ORDER BY combodoldur.idx" 'Set RS = CreateObject("ADODB.recordset") 'RS.Open strlog, adoCN, 1 ', 3 Set RS = adoCN.Execute(strlog) 'If RS.RecordCount > 0 Then 'RS.Movefirst UserForm1.Controls("SUZIZ1").AddItem "Tümü": UserForm1.Controls("SUZIZ4").AddItem "Tümü" Do While Not RS.EOF If RS(1) <> "" Then UserForm1.Controls("SUZIZ1").AddItem RS(1): UserForm1.Controls("SUZIZ4").AddItem RS(1) RS.MoveNext Loop 'End If 'RS.Close 'Set RS = Nothing strlog = "SELECT combodoldur.combo_tur FROM combodoldur GROUP BY combodoldur.combo_tur" 'Set RS = CreateObject("ADODB.recordset") 'RS.Open strlog, adoCN, 1 ', 3 Set RS = adoCN.Execute(strlog) 'If RS.RecordCount > 0 Then 'RS.Movefirst Do While Not RS.EOF If RS("combo_tur") <> "" Then UserForm1.Controls("COMBOSUZ").AddItem RS("combo_tur") RS.MoveNext Loop 'End If RS.Close Set RS = Nothing 'Call DbKapat End Sub Sub ComboIzinSuzDoldur() Dim pernogetir, strlog As String Dim acikti As Integer On Local Error Resume Next UserForm1.SUZIZ2.Clear: UserForm1.SUZIZ3.Clear pernogetir = UserForm1.Controls("TextBoxPerIDX").Value If pernogetir = "" Then Exit Sub 'Call DbAc strlog = "SELECT izinler.per_idx, izinler.izin_tur FROM izinler GROUP BY izinler.per_idx, izinler.izin_tur HAVING (((izinler.per_idx)=" & pernogetir & "))" 'Set RS = CreateObject("ADODB.recordset") 'RS.Open strlog, adoCN, 1 ', 3 Set RS = adoCN.Execute(strlog) 'If RS.RecordCount > 0 Then 'RS.Movefirst UserForm1.Controls("SUZIZ2").AddItem "Tümü" Do While Not RS.EOF UserForm1.Controls("SUZIZ2").AddItem RS(1) RS.MoveNext Loop 'End If RS.Close Set RS = Nothing 'Call DbKapat UserForm1.Controls("SUZIZ3").AddItem "Tümü" For i = 0 To 13 UserForm1.Controls("SUZIZ3").AddItem Val(Year(Date)) - i Next i End Sub Sub izin() Dim Dosya As Workbook Application.ScreenUpdating = False Dim sFile, sPath, Kontrol, ilkdosya, ilksayfa As String Dim sor, i, hakyili As Integer sor = MsgBox("İzin belgesi oluşturulacak. " & Chr(10) & "Devam edeyim mi ?", vbYesNo + vbQuestion + vbDefaultButton2, "Dikkat") If sor = vbNo Then Exit Sub Dim Yoll As String 'Yoll = Sheets("excelcozumleri").Range("d9").Value If Yoll = "" Then Yoll = ThisWorkbook.Path ilkdosya = ActiveWorkbook.Name: ilksayfa = ActiveSheet.Name Sheets("izin").Range("H14:I14").ClearContents Sheets("izin").Range("B10") = UserForm1.Controls("ComboBox17").Value 'birim Sheets("izin").Range("B12") = UserForm1.Controls("TextBox2").Value & " " & UserForm1.Controls("TextBox3").Value 'ad soyad Sheets("izin").Range("B14") = UserForm1.Controls("ComboBox18").Value 'görevi Sheets("izin").Range("H10") = UserForm1.Controls("TextBox1").Value 'per no 'Sheets("izin").Range("J14") = UserForm1.Controls("TextBox43").Value & " gün" '" ve " & UserForm1.Controls("TextBox44").Value & " gün yol" Sheets("izin").Range("B15") = UserForm1.Controls("TextBox46").Value 'açıklama Sheets("izin").Range("B20") = UserForm1.Controls("TextBox45").Value 'izin adresi For i = 0 To 10 If UserForm1.Controls("ComboBox41").ListIndex = i Then Sheets("izin").CheckBoxes("Onay" & i + 1).Value = True Else Sheets("izin").CheckBoxes("Onay" & i + 1).Value = False End If Next i '********************************************* Dim idxgetir As String idxgetir = UserForm1.Controls("TextBoxIzIDX").Value If idxgetir = "" Then Exit Sub 'Call DbAc strlog = "Select * From izinler Where izinler.idx=" & idxgetir 'Set RS = CreateObject("ADODB.recordset") 'RS.Open strlog, adoCN, 1 ', 3 Set RS = adoCN.Execute(strlog) 'If RS.RecordCount > 0 Then 'RS.Movefirst Sheets("izin").Range("J14") = RS("sure") Sheets("izin").Range("H12") = RS("iz_basl") Sheets("izin").Range("J12") = RS("ise_basl") Sheets("izin").Range("J16") = RS("tarih"): Sheets("izin").Range("L3") = RS("tarih") Sheets("izin").Range("J18") = idxgetir 'End If UserForm1.Controls("TextBoxIzIDX").Value = idxgetir RS.Close Set RS = Nothing 'Call DbKapat '********************************************* Dim X As Integer 'Dim sure(50) As Variant Dim Top_sure, izingun, top_kul_yil As Double Dim ilk As Date Dim son As Date 'Dim sonyilgirisgunu As Date Dim dogumtar As Date 'Dim oyılgiristar As Date Dim iz_basl As String Dim pernogetir, statu As String On Error Resume Next ilk = UserForm1.Controls("TextBox11").Value: If UserForm1.Controls("TextBox11").Value = "" Then Exit Sub son = UserForm1.Controls("TextBox12").Value: If UserForm1.Controls("TextBox12").Value = "" Then son = Date dogumtar = UserForm1.Controls("TextBox7").Value: If UserForm1.Controls("TextBox7").Value = "" Then Exit Sub statu = UserForm1.Controls("ComboBox14").Value 'sonyilgirisgunu = Format(Day(ilk) & "." & Month(ilk) & "." & Year(son), "dd.mm.yyyy") 'sonyil = Val(Year(son)): If son < sonyilgirisgunu Then sonyil = sonyil - 1 'kac = Application.WorksheetFunction.RoundDown((son - ilk) / 365.25, 0) pernogetir = UserForm1.Controls("TextBoxPerIDX").Value iz_basl = Format(UserForm1.Controls("TextBox42").Value, "Short Date") iz_basl = Month(iz_basl) & "/" & Day(iz_basl) & "/" & Year(iz_basl) 'iz_basl = Mid(UserForm1.Controls("TextBox42").Value, 4, 2) & "/" & Mid(UserForm1.Controls("TextBox42").Value, 1, 2) & "/" & Mid(UserForm1.Controls("TextBox42").Value, 7, 4) izingun = Val(Replace(UserForm1.Controls("TextBox43").Value, ",", ".")) 'Call DbAc strlog = "SELECT izinler.per_idx, izinler.izin_tur, Sum(izinler.sure) AS Toplasure FROM izinler WHERE (((izinler.iz_basl) < #" & iz_basl & "#)) GROUP BY izinler.per_idx, izinler.izin_tur HAVING (((izinler.per_idx)=" & pernogetir & ") AND ((izinler.izin_tur)='Yıllık'))" Set RS = CreateObject("ADODB.recordset") RS.Open strlog, adoCN, 1 ', 3 'Set RS = adoCN.Execute(strlog) If RS.RecordCount > 0 Then RS.MoveFirst Do While Not RS.EOF top_kul_yil = RS("Toplasure") RS.MoveNext Loop End If Top_sure = IzinHesapla(ilk, son, dogumtar, statu) - top_kul_yil If UserForm1.Controls("ComboBox41").Value = "Yıllık" Then Sheets("izin").Range("J10") = Top_sure - izingun Else Sheets("izin").Range("J10") = Top_sure '- izingun 'izin kağıdına bu tarihte kalan yıllık izni yazıyor X = 1 Do While Top_sure > 0 And IsEmpty(sure(kac - X + 1)) = False If sure(kac - X + 1) > Top_sure Then sure(kac - X + 1) = Top_sure Top_sure = Top_sure - sure(kac - X + 1) X = X + 1 Loop X = X - 1 Do While izingun > 0 And IsEmpty(sure(kac - X + 1)) = False If izingun < sure(kac - X + 1) Then sure(kac - X + 1) = izingun If statu = "Memur" Then hakyili = sonyil - X + 1 Else hakyili = sonyil - X If UserForm1.Controls("ComboBox41").Value = "Yıllık" Then Sheets("izin").Range("H14") = Sheets("izin").Range("H14") & " " & hakyili & " (" & sure(kac - X + 1) & ") " 'If UserForm1.Controls("ComboBox41").Value = "Yıllık" Then Sheets("izin").Range("H14") = Sheets("izin").Range("H14") & " " & sonyil - (X - 1) & " (" & sure(kac - X + 1) & ") " izingun = izingun - sure(kac - X + 1) X = X - 1 Loop RS.Close Set RS = Nothing 'Call DbKapat '********************************************* sFile = "izin_" & UserForm1.Controls("TextBox2").Value & "-" & UserForm1.Controls("TextBox3").Value & "_" & UserForm1.Controls("TextBox42").Value & "_" & UserForm1.Controls("ComboBox41").Value & ".xls" sPath = Yoll & "\izinler\" & sFile Kontrol = Dir(sPath) Application.DisplayAlerts = False 'If Kontrol = "" Then Sheets("izin").Select Sheets("izin").Copy ActiveWorkbook.SaveAs Filename:=sPath, FileFormat:= _ xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _ , CreateBackup:=False ActiveWorkbook.Save 'Else 'MsgBox "Bu izine ait İzin Belgesi zaten mevcut..." 'GoTo son 'End If ActiveWorkbook.Save MsgBox sFile & " ismiyle İzin Belgesi Oluşturuldu", , “Bilgi” UserForm1.Hide 'Application.Visible = True ActiveWorkbook.PrintPreview UserForm1.Show 'Application.Visible = False son: Windows(ilkdosya).Activate Sheets(ilksayfa).Select Application.ScreenUpdating = True End Sub Sub Rapor() On Local Error Resume Next Application.ScreenUpdating = False Dim s, kacay, sor, i As Integer Dim s1 As Worksheet Dim pa As Range Dim tarih As Date Dim Odenen, aidat, iskonto As Double sor = MsgBox("İzin raporu oluşturulacak. " & Chr(10) & "Devam edeyim mi ?", vbYesNo + vbQuestion + vbDefaultButton2, "Dikkat") If sor = vbNo Then Exit Sub Set s1 = Sheets("rapor") s1.Select s1.Range("B7:J500").ClearContents s = 7 's1.Cells(2, 2) = "" s1.Cells(4, 2) = UserForm1.Controls("SUZIZ4").Value For i = 0 To UserForm1.ListBox4.ListCount - 1 'If UserForm1.ListBox4.Selected(i) = True Then s1.Cells(s, 3) = UserForm1.ListBox4.List(i, 0) s1.Cells(s, 4) = UserForm1.ListBox4.List(i, 1) s1.Cells(s, 5) = UserForm1.ListBox4.List(i, 2) s1.Cells(s, 6) = UserForm1.ListBox4.List(i, 3) s1.Cells(s, 7) = UserForm1.ListBox4.List(i, 4) s1.Cells(s, = UserForm1.ListBox4.List(i, 5) s1.Cells(s, 9) = UserForm1.ListBox4.List(i, 6) s1.Cells(s, 10) = UserForm1.ListBox4.List(i, 7) s1.Cells(s, 2) = i + 1 s = s + 1 'End If Next s1.PageSetup.PrintArea = s1.Range(Cells(2, 2), Cells(s, 10)).Address 'MsgBox "İzin Raporu oluşturuldu", , “Bilgi” Application.ScreenUpdating = True End Sub Sub RaporPdf() Dim dosyaad, yol As String Dim s1 As Worksheet Set s1 = Sheets("rapor") yol = ThisWorkbook.Path & "\izinler" dosyaad = "Rapor_" & Replace(Replace(UserForm1.Controls("SUZIZ4").Value, " / ", "_"), " ", "-") dosyaad = dosyaad & "_" & Date s1.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ yol & "\" & dosyaad & ".pdf", _ Quality:=xlQualityStandard, IncludeDocProperties:=True, OpenAfterPublish:=True MsgBox "İzin Raporu oluşturuldu. Dosya, " & dosyaad & " adı ile kaydedildi! ", , "Dosya kaydedildi" End Sub Sub RaporXls() Dim dosyaad, yol, sPath, Kontrol As String Dim s1 As Worksheet Set s1 = Sheets("rapor") yol = ThisWorkbook.Path & "\izinler" dosyaad = "Rapor_" & Replace(Replace(UserForm1.Controls("SUZIZ4").Value, " / ", "_"), " ", "-") dosyaad = dosyaad & "_" & Date sPath = yol & "\" & dosyaad & ".xls" Kontrol = Dir(sPath) Application.DisplayAlerts = False 'If Kontrol = "" Then Sheets("rapor").Select Sheets("rapor").Copy ActiveWorkbook.SaveAs Filename:=sPath, FileFormat:= _ xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _ , CreateBackup:=False ActiveWorkbook.Save 'Else 'MsgBox "Bu rapor mevcut! Lütfen izinler klasöründekini siliniz." 'GoTo son 'End If ActiveWorkbook.Save MsgBox dosyaad & " ismiyle İzin Raporu Oluşturuldu", , “Bilgi” UserForm1.Hide 'Application.Visible = True ActiveWorkbook.PrintPreview UserForm1.Show 'Application.Visible = False son: Application.ScreenUpdating = True End Sub Sub PersonelRaporu() On Local Error Resume Next Application.ScreenUpdating = False Dim s, kacay, sor, i As Integer Dim mesajmetni1, mesajmetni2 As String Dim s1 As Worksheet Dim pa As Range Dim tarih As Date Dim Odenen, aidat, iskonto As Double sor = MsgBox("Seçili personele ait izin raporu oluşturulacak. " & Chr(10) & "Devam edeyim mi ?", vbYesNo + vbQuestion + vbDefaultButton2, "Dikkat") If sor = vbNo Then Exit Sub Set s1 = Sheets("personelizin") s1.Select s1.Range("B10:G150").ClearContents: s1.Range("B4:G6").ClearContents s1.Range("G4") = Date s = 10 If UserForm1.Controls("SUZIZ3").Value <> "Tümü" And UserForm1.Controls("SUZIZ3").Value <> "" Then mesajmetni1 = UserForm1.Controls("SUZIZ3").Value & " yılında " If UserForm1.Controls("SUZIZ2").Value <> "Tümü" And UserForm1.Controls("SUZIZ2").Value <> "" Then mesajmetni2 = UserForm1.Controls("SUZIZ2").Value s1.Cells(4, 2) = "Sayın " & UserForm1.Controls("Textbox2").Value & " " & UserForm1.Controls("Textbox3").Value s1.Cells(6, 2) = mesajmetni1 & "Kullanılan " & mesajmetni2 & " izinler aşağıdadır. Kalan yıllık izin hakkınız: " & UserForm1.Controls("Textbox47").Value & " gündür." For i = 0 To UserForm1.ListBox3.ListCount - 1 'If UserForm1.ListBox4.Selected(i) = True Then s1.Cells(s, 3) = UserForm1.ListBox3.List(i, 0) s1.Cells(s, 4) = UserForm1.ListBox3.List(i, 1) s1.Cells(s, 5) = UserForm1.ListBox3.List(i, 2) s1.Cells(s, 6) = UserForm1.ListBox3.List(i, 4) s1.Cells(s, 7) = UserForm1.ListBox3.List(i, 6) s1.Cells(s, 2) = i + 1 s = s + 1 'End If Next Sheets("personelizin").PageSetup.PrintArea = Sheets("personelizin").Range(Cells(2, 2), Cells(s, 7)).Address Dim dosyaad, yol As String yol = ThisWorkbook.Path & "\izinler" dosyaad = Replace(UserForm1.Controls("TextBox2").Value, " ", "_") & "_" & Replace(UserForm1.Controls("TextBox3").Value, " ", "_") dosyaad = dosyaad & "_" & Date s1.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ yol & "\" & dosyaad & ".pdf", _ Quality:=xlQualityStandard, IncludeDocProperties:=True, OpenAfterPublish:=True Sheets("anasayfa").Select MsgBox "Personele ait izin raporu oluşturuldu. Dosya, " & dosyaad & " adı ile kaydedildi! ", , "Dosya kaydedildi" Application.ScreenUpdating = True End Sub Sub GunlukRapor() Dim Dosya As Workbook Application.ScreenUpdating = False 'Dim aranantarih, tarih As Date Dim aranantarih As String Dim s As Integer aranantarih = Sheets("anasayfa").Range("D5").Value aranantarih = Month(aranantarih) & "/" & Day(aranantarih) & "/" & Year(aranantarih) Sheets("anasayfa").Range("B7:K500").ClearContents s = 7 Call DbAc Set RS = CreateObject("ADODB.recordset") strlog = "SELECT personel.per_no, personel.ad, personel.soyad, personel.dept, personel.gorev, izinler.izin_tur, izinler.iz_basl, izinler.iz_bitis, izinler.ise_basl, izinler.aciklama FROM personel INNER JOIN izinler ON personel.idx = izinler.per_idx" strlog = strlog & " WHERE izinler.iz_basl <= #" & aranantarih & "# And izinler.ise_basl > #" & aranantarih & "#" strlog = strlog & " ORDER BY personel.per_no" 'strlog = "SELECT izinler.idx, izinler.per_idx, izinler.iz_basl, izinler.ise_basl FROM izinler WHERE izinler.iz_basl<='" & aranantarih & "' And izinler.ise_basl>'" & aranantarih & "'" RS.Open strlog, adoCN, 1 ', 3 'Set RS = adoCN.Execute(strlog) If RS.RecordCount > 0 Then RS.MoveFirst Do While Not RS.EOF Sheets("anasayfa").Cells(s, 2) = s - 6 Sheets("anasayfa").Cells(s, 3) = RS("per_no") Sheets("anasayfa").Cells(s, 4) = RS("ad") & " " & RS("soyad") Sheets("anasayfa").Cells(s, 5) = RS("dept") Sheets("anasayfa").Cells(s, 6) = RS("gorev") Sheets("anasayfa").Cells(s, 7) = RS("izin_tur") Sheets("anasayfa").Cells(s, = Format(RS("iz_basl"), "Short Date") Sheets("anasayfa").Cells(s, 9) = Format(RS("iz_bitis"), "Short Date") Sheets("anasayfa").Cells(s, 10) = Format(RS("ise_basl"), "Short Date") Sheets("anasayfa").Cells(s, 11) = RS("aciklama") s = s + 1 RS.MoveNext Loop End If RS.Close Set RS = Nothing Call DbKapat Sheets("anasayfa").PageSetup.PrintArea = Sheets("anasayfa").Range(Cells(4, 2), Cells(s, 11)).Address son: Application.ScreenUpdating = True End Sub yardım için simdiden teşekkür ederim. Mayıs 8, 2023 Sam tarafından düzenlendi
Drall Mesaj tarihi: Mayıs 7, 2023 Mesaj tarihi: Mayıs 7, 2023 Allah askina spo Onceden sanki bi kod paylasma modu da vardi, böyle gorece kucuk bi karenin icine koyuyodu Kod hakkinda hicbir bilgim yokken ben niye bu topicteyim, niye cevap yaziyorum? Bi is bulsam iyi olcak
Goering Mesaj tarihi: Mayıs 7, 2023 Mesaj tarihi: Mayıs 7, 2023 kodu düzeltme sansin yok ama büyük ihtimalle eski halini bulabilirsin @mucahitclk CLK kardes /TEMP/ sol ustten, ac/open'a git ordan eski hali cikar - tempory folder linki orada var. bana da 2-3k bir şey atarsan 1
mucahitclk Mesaj tarihi: Mayıs 7, 2023 Konuyu açan Mesaj tarihi: Mayıs 7, 2023 öyle bulamadığım için yardım talebinde bulundum. uzun zaman sonra buldum uygulamayı da zaten. destek talebim kod dizisini yazabilecek bir arkadaş aramam.
mucahitclk Mesaj tarihi: Mayıs 7, 2023 Konuyu açan Mesaj tarihi: Mayıs 7, 2023 Goering, 07.05.2023 20:58 tarihinde dedi ki: CLK kac senesinin modeli ? baya eski 2017 falandır. 365 de açılıyor çalışıyor sıkıntısı yok
Goering Mesaj tarihi: Mayıs 7, 2023 Mesaj tarihi: Mayıs 7, 2023 abi sacma sapan şirketinin HR macrosunu silmişsin, en son kısmıni ? nasil tamamlayalım? formlardan izinler falan alıyor baya spesifik kolelerinden birine yazdirmissin ? 1
Dark_Soul Mesaj tarihi: Mayıs 7, 2023 Mesaj tarihi: Mayıs 7, 2023 (düzenlendi) Şu kodu yazanı ben direk işten atardım, else if yazamamış tembellikten yada yetersizlikten. Mayıs 8, 2023 Sam tarafından düzenlendi
Goering Mesaj tarihi: Mayıs 8, 2023 Mesaj tarihi: Mayıs 8, 2023 koda baktim da aciktan database sifre/username/ip atmissin hemen sil bence
Goering Mesaj tarihi: Mayıs 8, 2023 Mesaj tarihi: Mayıs 8, 2023 (düzenlendi) write ve update yetkisi olduguna gore admin yetkisi olan db accountu... admin varsa silsin Mayıs 8, 2023 Goering tarafından düzenlendi
dasaaa Mesaj tarihi: Mayıs 8, 2023 Mesaj tarihi: Mayıs 8, 2023 abi harbi.. 123 olmasi iyiymis ama sonunda
Sam Mesaj tarihi: Mayıs 8, 2023 Mesaj tarihi: Mayıs 8, 2023 şifre geçen yerleri sildim, spoilera aldım.
Goering Mesaj tarihi: Mayıs 8, 2023 Mesaj tarihi: Mayıs 8, 2023 @mucahitclk kodda sildiğin yerin onemi oldugunu düşünmüyorum, son ELSE. ..... ELSE x . .... kismi isi yapıyor gibi kodda, x olan kisim olmasa da olur
miyaw33 Mesaj tarihi: Mayıs 8, 2023 Mesaj tarihi: Mayıs 8, 2023 Bence başlığı komple silelim, adam işinden falan olur, yarın öbür gün birileri buradaki şifreleri kullanıp iş yapar. Patiyi koruyalim
pascalnouman Mesaj tarihi: Mayıs 8, 2023 Mesaj tarihi: Mayıs 8, 2023 muco clk yi ver bir tur binelim basligi silmeyiz yoxa !!
neutrino Mesaj tarihi: Mayıs 15, 2023 Mesaj tarihi: Mayıs 15, 2023 Goering, 8.05.2023 00:47 tarihinde dedi ki: koda baktim da aciktan database sifre/username/ip atmissin hemen sil bence Lol tam bir ik’cı aptallığı.
Goering Mesaj tarihi: Mayıs 15, 2023 Mesaj tarihi: Mayıs 15, 2023 AI'ya sorsa bence tamamlayabilirdi, forumdan biri oldugunu tahmin ediyorum eskisehirde
DoruK Mesaj tarihi: Mayıs 16, 2023 Mesaj tarihi: Mayıs 16, 2023 Ne kadar kotu bir kod bu ya ahah chatgpt ise yarayabilir elbet
Öne çıkan mesajlar