Asayiş/Önleyici Şube Müdürlükleri için basit bir personel performans puanlama sistemi - Baskı Önizleme +- AccessTr.neT (https://accesstr.net) +-- Forum: Microsoft Access (https://accesstr.net/forum-microsoft-access.html) +--- Forum: Access Örnekleri ve Uygulamaları (https://accesstr.net/forum-access-ornekleri-ve-uygulamalari.html) +--- Konu Başlığı: Asayiş/Önleyici Şube Müdürlükleri için basit bir personel performans puanlama sistemi (/konu-asayis-onleyici-sube-mudurlukleri-icin-basit-bir-personel-performans-puanlama-sistemi.html) |
Cvp: Asayiş/Önleyici Şube Müdürlükleri için basit bir personel performans puanlama sistemi - C*e*l*o*y*c*e - 27/08/2010 Buda benden olsun Polisleri severim Cvp: Asayiş/Önleyici Şube Müdürlükleri için basit bir personel performans puanlama sistemi - abdulvahap - 27/08/2010 hocam çok teşekkürler makbule geçti yalnız tarih kriterini sorması lazım birde üst bilgisini atayıp renkli yapabilirmiyiz acaba... Cvp: Asayiş/Önleyici Şube Müdürlükleri için basit bir personel performans puanlama sistemi - C*e*l*o*y*c*e - 27/08/2010 ben tarih sormasın diye SRGO-c isminde yeni sorgular yapmıştım onları kullandım eger sen tarih sormasını istiyorsan kodlardki misal SRG0-c yi SRG0,digerini SRG1 gbi degiştir yani senin asıl sorgularını kullan ,renk işini ise bilmiyorum kolay gelsin Cvp: Asayiş/Önleyici Şube Müdürlükleri için basit bir personel performans puanlama sistemi - abdulvahap - 27/08/2010 hocam çok teşekkür ederim seruz hocanın bu örnek formülünü uyarlayabilirmiyiz acaba? Option Compare Database 'Use database order for string comparisons Option Explicit Dim ExcelDosyasi As Object Private Sub BasTarihi_AfterUpdate() Me.BitTarihi = Me.BasTarihi + 6 End Sub Private Sub btn_EXCEL_Click() On Error GoTo Err_btn_EXCEL_Click Dim Rs As New ADODB.Recordset Dim i, BasSatirSayisi, SatirSayisi, SutunSayisi As Integer If IsNull(Me.Secilen_MAHALLE) Then Exit Sub '--------------------------------------------------------------------------------------------------------- 'Excel açılıyor ve başlıklar ayarlanıyor '--------------------------------------------------------------------------------------------------------- Set ExcelDosyasi = CreateObject("Excel.Application") With ExcelDosyasi .Application.Visible = True .UserControl = True .Workbooks.Add .Sheets(1).Name = Me.Secilen_MAHALLE End With '--------------------------------------------------------------------------------------------------------- 'Tablo açılıyor '--------------------------------------------------------------------------------------------------------- DoCmd.SetWarnings False DoCmd.OpenQuery "HAFTALIK_Yarat" DoCmd.SetWarnings False '--------------------------------------------------------------------------------------------------------- 'Tablo açılıyor '--------------------------------------------------------------------------------------------------------- Rs.Open "HAFTALIK_Capraz", CurrentProject.Connection, adOpenKeyset, adLockReadOnly SutunSayisi = Rs.Fields.Count BasSatirSayisi = 3 SatirSayisi = BasSatirSayisi 'Başlıklar Oluşturuluyor With ExcelDosyasi .Sheets(1).Select .ActiveWindow.DisplayGridlines = False .Cells(1, 2) = Me.Secilen_MAHALLE & " BELDESİ HAFTALIK ÇALIŞMA PROGRAMI" .Cells.Font.Name = "Arial" .Cells.Font.Size = 20 'Kayıt yoksa çıkılıyor If Rs.RecordCount = 0 Then .Cells(2, 2) = "Kayıt bulunamadı" Rs.Close Exit Sub End If 'Sütun Başlıkları atanıyor, Tarih olan alanların formatı değiştiriliyor. For i = 1 To SutunSayisi If Rs.Fields(i - 1).Name = "Saat" Then .Cells(SatirSayisi, i + 1) = Rs.Fields(i - 1).Name Else .Cells(SatirSayisi, i + 1) = CVDate(Rs.Fields(i - 1).Name) .Cells.NumberFormat = "[$-F800]dddd, mmmm dd, yyyy" End If Next i End With '--------------------------------------------------------------------------------------------------------- ' Kayıtlar Okunuyor ve Yazılıyor '--------------------------------------------------------------------------------------------------------- Do Until Rs.EOF With ExcelDosyasi SatirSayisi = SatirSayisi + 1 'Satır Detayı For i = 1 To SutunSayisi .Cells(SatirSayisi, i + 1) = Rs.Fields(i - 1) Next i 'Sonraki Kayıt Rs.MoveNext End With Loop Rs.Close '----------------------------------------------------------------------- ' Sütun Formatları '----------------------------------------------------------------------- With ExcelDosyasi .Range(.Cells(3, 2).Address, .Cells(SatirSayisi, SutunSayisi + 1).Address).HorizontalAlignment = xlCenter .Cells.EntireColumn.AutoFit .Columns("A").EntireColumn.ColumnWidth = 1 .Columns("B").EntireColumn.ColumnWidth = 11 ' Çerçeve İşlemleri .Range(.Cells(3, 2).Address, .Cells(SatirSayisi, SutunSayisi + 1).Address).Select .Selection.Borders(xlDiagonalDown).LineStyle = xlNone .Selection.Borders(xlDiagonalUp).LineStyle = xlNone With .Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With ' Yazıcı Ayarları With .ActiveSheet.PageSetup .PrintTitleRows = "" .PrintTitleColumns = "" End With .ActiveSheet.PageSetup.PrintArea = "" With .ActiveSheet.PageSetup .LeftHeader = "" .CenterHeader = "" .RightHeader = "" .LeftFooter = "" .CenterFooter = "" .RightFooter = "" .LeftMargin = .Application.InchesToPoints(0.4) .RightMargin = .Application.InchesToPoints(0.4) .TopMargin = .Application.InchesToPoints(0.4) .BottomMargin = .Application.InchesToPoints(0.4) .HeaderMargin = .Application.InchesToPoints(0.4) .FooterMargin = .Application.InchesToPoints(0.4) .PrintHeadings = False .PrintGridlines = False .PrintComments = xlPrintNoComments .PrintQuality = 600 .CenterHorizontally = True .CenterVertically = False .Orientation = xlLandscape .Draft = False .PaperSize = xlPaperLetter .FirstPageNumber = xlAutomatic .Order = xlDownThenOver .BlackAndWhite = False .Zoom = False .FitToPagesWide = 1 .FitToPagesTall = 1 .PrintErrors = xlPrintErrorsDisplayed End With End With '----------------------------------------------------------------------- ExcelDosyasi.Range("A1").Select Set ExcelDosyasi = Nothing Exit_btn_EXCEL_Click: Exit Sub Err_btn_EXCEL_Click: MsgBox Err.Description Resume Exit_btn_EXCEL_Click End Sub Cvp: Asayiş/Önleyici Şube Müdürlükleri için basit bir personel performans puanlama sistemi - mehmetdemiral - 27/08/2010 Sayın Abdulvahap Bu birşakaydı, bizimle Mevlüt(Celoyce) ve Seruz arasında.. Sizinle en ufak bir ilgisi yok. O genelde " P ROĞRAM" yazdığı için doğrusu da PROGRAM olduğu için ona takılıyoruz. Yalnız bu arada bu sitenin bir farkını belirteyim. Siz burada sayın Taruz'a teşekkür edebiliyorsunuz ama sayın Taruz sitesinde başta benim adım olmak üzere bu sitenin adının bile geçmesine dayanamıyor. Bununla ilgili yakın zamanda birden fazla örnek vardır ki sayın Taruz sitesinden bu ve benzeri mesajları silmiştir. Olsun.. BizMEvlana gibiyiz demiştik. Onu da böyle seviyoruz) Cvp: Asayiş/Önleyici Şube Müdürlükleri için basit bir personel performans puanlama sistemi - C*e*l*o*y*c*e - 27/08/2010 vahap bey exel konusunda seruz hocadan yardım isteyin ,ben pek anlamam |