Kaydet gönder sil

[ahmetcahan2010]

Elimde Adı ve soyadı-Görevi-Durum-Branşı-Kategorisi-Başlama trh-Bitiş trh-Toplam gün veri başlıklarını içeren personel formu mevcut bu formda giriş yapıldıktan sonra;

Kod:  Tüm Kodu Seç (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
DATA sayfasına kaydet tuşuyla kaydediyoruz.
data KAYDET tuşunda data sayfasına yazmada diğer başlıklar yazıyor otomatikman ama Bitiş trh-Toplam gün yazmıyor
Burda görev alan kişi için durum da TAŞERON geçiyorsa alamaz gözükecek bu görevliler data_gorev_alamaz sheetine gidecek, ve işlem sheetinden otomatikman silinmeli.

Aynı yer ve tarihteki müsabakalar için tüm sheetler geçerli olmak üzere birden fazla kişi olsun olmasın bir kere kayıt (sıra no) verecek. Burda amaç kişinin aynı gün başka yerde mükerrer görev almasının önüne geçebilmeli.

Burda görev alan kişi için durum da KADROLU geçiyorsa alabilir gözükecek. data_gorev_alabilir. sheetine gidecek,
data_gorev_alamaz ve data_gorev_alabilir. sheetleri kayıt yapamaz durumdadır.

Module 1 sayfası kodları

Kod: [Seç]

Sub Makro1()
'
' Makro1 Makro
' Sub Makro1()     Application.ActivePrinter = "Ne05: üzerindeki \\Printserver1\PRINTER-77 "     ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _         "Ne05: üzerindeki \\Printserver1\PRINTER-77 ", Collate:=True End Sub
'
' Klavye Kısayolu: Ctrl+ü
'
    Range("C13").Select
    ActiveWindow.SmallScroll Down:=6
    Range("E21").Select
    Application.ActiveProtectedViewWindow.Edit UpdateLinks:=False
    ActiveSheet.Shapes.Range(Array("CommandButton1")).Select
    Selection.Delete
    Selection.Cut
    ActiveWindow.SmallScroll Down:=36
    Windows("Kitap1").Activate
    Range("D20").Select
    ActiveSheet.Paste
    ActiveSheet.Shapes.Range(Array("CommandButton1")).Select
    Range("E23").Select
    ActiveSheet.Shapes.Range(Array("CommandButton1")).Select
    Selection.ShapeRange.IncrementLeft -198.75
    Selection.ShapeRange.IncrementTop -9.75
    Range("C23").Select
    ActiveSheet.Shapes.Range(Array("CommandButton1")).Select
    Range("I17").Select
    ActiveSheet.Shapes.Range(Array("CommandButton1")).Select
    Range("D22").Select
    Sheets("Sayfa1").Select
    Range("I12").Select
    ChDir "C:\Users\Win10\Desktop"
    ActiveWindow.SmallScroll Down:=-24
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\Win10\Desktop\kontrol çizelgesi.xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\Win10\Desktop\kontrol çizelgesi.xlsm", FileFormat:= _
        xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    Range("I7").Select
End Sub
module 2

Kod: [Seç]

Sub data_kaydet()
Application.ScreenUpdating = False
On Error Resume Next
Set s1 = ThisWorkbook.Worksheets("işlem")
Set s2 = ThisWorkbook.Worksheets("data")
Set s3 = ThisWorkbook.Worksheets("data_gorev_alamaz")
Set s4 = ThisWorkbook.Worksheets("data_gorev_alabilir")
sonsatir = s2.Range("A65536").End(xlUp).Row + 1
s2.Cells(sonsatir, 1) = s1.Cells(9, "b")
s2.Cells(sonsatir, 2) = s1.Cells(9, "d")
s2.Cells(sonsatir, 3) = s1.Cells(9, "e")
s2.Cells(sonsatir, 4) = s1.Cells(9, "f")
s2.Cells(sonsatir, 5) = s1.Cells(9, "g")
s2.Cells(sonsatir, 6) = s1.Cells(9, "h")
s2.Cells(sonsatir, 7) = s1.Cells(9, "ı")
s2.Cells(sonsatir, 8) = s1.Cells(9, "j")

s2.Cells(sonsatir, 9) = s1.Cells(13, "b")
s2.Cells(sonsatir, 10) = s1.Cells(13, "c")
s2.Cells(sonsatir, 11) = s1.Cells(13, "d")
s2.Cells(sonsatir, 12) = s1.Cells(13, "e")
s2.Cells(sonsatir, 13) = s1.Cells(13, "f")
s2.Cells(sonsatir, 14) = s1.Cells(13, "g")
s2.Cells(sonsatir, 15) = s1.Cells(13, "h")
s2.Cells(sonsatir, 16) = s1.Cells(13, "ı")

s2.Cells(sonsatir, 17) = s1.Cells(17, "b")
s2.Cells(sonsatir, 18) = s1.Cells(17, "c")
s2.Cells(sonsatir, 19) = s1.Cells(17, "d")
s2.Cells(sonsatir, 20) = s1.Cells(17, "e")
s2.Cells(sonsatir, 21) = s1.Cells(17, "f")
s2.Cells(sonsatir, 22) = s1.Cells(17, "g")
s2.Cells(sonsatir, 23) = s1.Cells(17, "h")
s2.Cells(sonsatir, 24) = s1.Cells(17, "ı")
s2.Cells(sonsatir, 25) = s1.Cells(17, "j")

s2.Cells(sonsatir, 26) = s1.Cells(20, "c")
s2.Cells(sonsatir, 27) = s1.Cells(20, "e")

Application.ScreenUpdating = True
MsgBox "İşlem TAMAM.", vbInformation
End Sub

Sub tabloyu_temizle()
Sheets("işlem").Range("b9") = ""
Sheets("işlem").Range("e9:j9") = ""
Sheets("işlem").Range("b13:j13") = ""
Sheets("işlem").Range("c17:c18") = ""
Sheets("işlem").Range("f17:f18") = ""
Sheets("işlem").Range("g17:g18") = ""
Sheets("işlem").Range("j17:j18") = ""
Sheets("işlem").Range("e20:j21") = ""
End Sub