Check In, Check Out

  1. 3 minggu lalu
    Di sunting 3 minggu lalu oleh haidaramzy

    Selamat siang master, ane newbie mau minta tolong bgt bagaimana caranya supaya ketika kita masukan NIP di Checkin NIP langsung ke enter terus masuk ke sheet sebelah, di sheet sebelah kolom check in keluar jam berapa dia Check in nya, terima kasih banyak master2 sebelumnya
    Contoh.xlsx

    pada baris :

    sName = ActiveSheet.Shapes(Application.Caller).Name
        If InStr(1, "btnSave", sName) Then
            '+-- Validasi nama sheet aktif.
            Set xlSheet = ActiveSheet
            If InStr(1, "Sheet1", xlSheet.CodeName) Then
                bValid = True
            Else
                Set xlSheet = Nothing
            End If
        End If


    edit menjadi :

        Set xlSheet = Sheet2
        bValid = True

  2. @haidaramzy

    cara input niknya bagaimana? saya lihat difilenya ada keterangan

    *) Sihlakan Tap Barcode anda sesuai dengan Check In & Check Out

    apakah menggunakan scan barcode? kalau cuma scan barcode trus namanya diambil dari mana? apakah ada sheet untuk daftar karyawannya?

  3. Iya menggunakan scanner, Itu yang diambil NIP nya dari sheet sebelah mas, contoh check in dimasukkan NIP DLT224, maka dari sheet sebelah di kolom F2 keluar jam berapa dia check in gitu mas hehe

  4. @haidaramzy coba skrip berikut pada modul sheet2 :

    Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("C11,H11")) Is Nothing And Target <> "" Then
        With Sheet3
            r = .Range("B:B").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole).Row
            c = Target.Column
            If c = 3 Then
                .Cells(r, c + 3) = Now
            Else
                .Cells(r, c - 1) = Now
            End If
        End With
    Else
        Exit Sub
    End If
    Target = ""
    End Sub

  5. @manweljs_ @haidaramzy coba skrip berikut pada modul sheet2 :
    Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("C11,H11")) Is Nothing And Target <> "" Then With Sheet3 r = .Range("B:B").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole).Row c = Target.Column If c = 3 Then .Cells(r, c + 3) = Now Else .Cells(r, c - 1) = Now End If End With Else Exit Sub End If Target = "" End Sub

    Makasih mas
    lalu kalo untuk ditambah status terakhir siapa NIP yang ter scan masuk
    seperti contoh terlampir pada kolom E15 gimana ya mas ? saya pakai vlookup tidak bisa karena langsung hilang lagi hehe

    Contoh terlampirContoh.xlsx

  6. caranya mudah sekali kalau anda mau BERUSAHA memahami skrip tersebut :)
    sebelum baris Target = "" (sebelum dihapus) salin nilai targetnya ke E16 Range("E16") = Target

    @haidaramzy ...saya pakai vlookup tidak bisa karena langsung hilang lagi...

    kalau tidak mau hilang baris Target = "" dihapus sj

    demikian. silahkan dipelajari

  7. @manweljs_ caranya mudah sekali kalau anda mau BERUSAHA memahami skrip tersebut :)
    sebelum baris Target = "" (sebelum dihapus) salin nilai targetnya ke E16 Range("E16") = Target

    kalau tidak mau hilang baris Target = "" dihapus sj

    demikian. silahkan dipelajari

    Iyaa maaf mas, itu buat skrip c - 1 juga ketumpuk ke scan in mas, jadi suda saya ganti c + 0/ c saja hehe
    Kalo supaya ga ada debug error gitu saya tambahkan error go to 0 bisa ga mas?

  8. @haidaramzy ...itu buat skrip c - 1 juga ketumpuk ke scan in mas, jadi suda saya ganti c + 0/ c saja...

    kalau cuma nilai c maka yg akan diisi di kolom H bukan di kolom J, entahlah kalau file real anda berbeda kolomnya

    ...Kalo supaya ga ada debug error gitu saya tambahkan error go to 0 bisa ga mas?...

    penyebab errornya apa harus diketahui dulu, kalau cuma errornya di biarin aja tambahkan on error resume next bagian awal skrip tersebut.

  9. Di sunting 3 minggu lalu oleh haidaramzy

    @manweljs_ kalau cuma nilai c maka yg akan diisi di kolom H bukan di kolom J, entahlah kalau file real anda berbeda kolomnya

    penyebab errornya apa harus diketahui dulu, kalau cuma errornya di biarin aja tambahkan on error resume next bagian awal skrip tersebut.

    Baik mas terima kasih banyak infonya, sudah ane tambahin errhandler buat mengatasi nya, ini saya ada kesulitan dalam simpan sheet ke workbook baru, contoh semisal di sheet 1 ada tombol save, nanti sheet2 akan tersimpan secara file terpisah

    Mohon di koreksi skrip dibawah ini jika ane ada keliru

     Public Sub SaveSheet()
        Dim xlSheet As Worksheet, xlBook As Workbook
        Dim bValid As Boolean
        Dim sName As String
        
        On Error GoTo errHandler
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
            .EnableCancelKey = xlDisabled
            .DisplayAlerts = False
        End With
        '+-- Validasi nama tombol yang memanggil prosedur.
        sName = ActiveSheet.Shapes(Application.Caller).Name
        If InStr(1, "btnSave", sName) Then
            '+-- Validasi nama sheet aktif.
            Set xlSheet = ActiveSheet
            If InStr(1, "Sheet1", xlSheet.CodeName) Then
                bValid = True
            Else
                Set xlSheet = Nothing
            End If
        End If
                            
        If bValid Then
            Dim sFileName As String, sInitialName As String, sTitle As String, sRange As String
            Dim objDlg As FileDialog
            Dim bOk As Boolean
            Dim vResult
            
            '+-- Baris tabel untuk SHEET1
            If xlSheet.CodeName = "DATABASE" Then
                sInitialName = "Absensi RW "
                sTitle = "Save As..."
                sRange = "A:G"
            Else
                MsgBox "Invalid or can't find object name!", vbCritical Or vbOKOnly, "Error"
                Exit Sub
            End If
            
            vResult = Application.GetSaveAsFilename(ThisWorkbook.Path & Chr$(92) & sInitialName, "Excel Files (*.xlsx), *.xlsx", , sTitle)
            If vResult <> False Then
                bOk = True
                '+--- Apakah file sudah dibuka.
                For Each xlBook In Application.Workbooks
                    If (xlBook.FullName = vResult) Then
                        '+--- File sedang dibuka.
                        sFileName = Dir$(xlBook.FullName)
                        MsgBox "Can't save when file is opened, close it first ! " & _
                            "file " & sFileName & ", and then try again.", vbCritical Or vbOKOnly, "Error"
                        bOk = False
                        Exit For
                    End If
                Next
                
                If bOk Then
                    '+--- Overwrite file?
                    If (Len(Dir(vResult)) > 0) Then
                        bOk = (MsgBox("The file with same name is already exists. Do you want to " & _
                            "Overwrite this files?", vbExclamation Or vbYesNo, "Status") = vbYes)
                    End If
                    
                    '+--- Jika overwrite atau file tidak ada sebelumnya,
                    '+--- lakukan proses penyimpanan file.
                    If bOk Then
                        '+--- Copy ke workbook baru.
                        Set xlBook = Application.Workbooks.Add
                        
                        Application.DisplayAlerts = False
                        '+--- Copy range sumber ke workbook baru.
                        xlSheet.Range(sRange).Copy Workbooks(xlBook.Name).Sheets(1).Range(sRange)
                        With xlBook.Sheets(1)
                            .Name = sInitialName
                            .Range(sRange).EntireColumn.Copy
                            Selection.PasteSpecial Paste:=xlPasteValues
                            .Range("A1").Select
                            Application.CutCopyMode = False
                            ActiveWindow.DisplayGridlines = False
                        End With
                        
                        '+---  Hapus sheet lainnya.
                        For Each xlSheet In xlBook.Worksheets
                            If (xlSheet.Name <> sInitialName) Then
                                xlSheet.Delete
                            End If
                        Next
                        
                        xlBook.Activate
                        xlBook.SaveAs vResult
                        
                        ThisWorkbook.Save
                        Application.DisplayAlerts = True
                        
                        MsgBox "Saving Process [" & sInitialName & "] Successful.", vbInformation Or vbOKOnly, "Information"
                    End If
                End If
            Else
                'MsgBox "Saving Process [" & sInitialName & "] Cancelled!", vbExclamation Or vbOKOnly
            End If
        Else
            '+-- Pesan kesalahan jika prosedur dipanggil oleh tombol atau sheet yang tidak dikenal.
            MsgBox "This action can only be done through the associated Sheet!", vbExclamation Or vbOKOnly, "Error"
        End If
    
    errHandler:
        If Err.Number Then
            MsgBox "Unhandled process error occured! Error #" & Hex(Err.Number) & vbCrLf & _
                Err.Description, vbCritical Or vbOKOnly, "Process Error"
        End If
            
            On Error Resume Next
        '+--- Perlu tidak perlu, lakukan saja proses clean-up.
        Set xlSheet = Nothing
        If (Not xlBook Is Nothing) Then
            xlBook.Close SaveChanges:=False
            Set xlBook = Nothing
        End If
        Set objDlg = Nothing
        
        With Application
            .DisplayAlerts = True
            .EnableEvents = True
            .EnableCancelKey = xlInterrupt
            .ScreenUpdating = True
        End With
        
        Err.CLEAR
        On Error GoTo 0
    End Sub

  10. @haidaramzy sebaiknya dilampirkan aja filenya

    saya harus cek sendiri nama tombol yang digunakan, sheet code name serta sheet name nya.
    skrip diatas adalah untuk mengkopy sheet yang sedang aktif yaitu sheet yang bernama DATABASE dan code namenya Sheet1. hanya saja ada sedikit kesalahan pada baris :

     If xlSheet.CodeName = "DATABASE" Then


    seharusnya :

     If xlSheet.Name = "DATABASE" Then


    Note : filenya yang saya minta dilampirkan tidak perlu ada datanya, yang penting ada tombol yang digunakan, sheet-sheetnya lengkap dan nama sheetnya jangan dirubah.

  11. 2 minggu lalu

    contohnya seperti ini mas, terdapat error "Invalid object name"
    Contoh.xlsm

  12. manweljs_

    Jul 27 Terverifikasi Jawaban Terpilih + 10.786 Poin

    pada baris :

    sName = ActiveSheet.Shapes(Application.Caller).Name
        If InStr(1, "btnSave", sName) Then
            '+-- Validasi nama sheet aktif.
            Set xlSheet = ActiveSheet
            If InStr(1, "Sheet1", xlSheet.CodeName) Then
                bValid = True
            Else
                Set xlSheet = Nothing
            End If
        End If


    edit menjadi :

        Set xlSheet = Sheet2
        bValid = True

  13. @manweljs_ pada baris :

    sName = ActiveSheet.Shapes(Application.Caller).Name
        If InStr(1, "btnSave", sName) Then
            '+-- Validasi nama sheet aktif.
            Set xlSheet = ActiveSheet
            If InStr(1, "Sheet1", xlSheet.CodeName) Then
                bValid = True
            Else
                Set xlSheet = Nothing
            End If
        End If


    edit menjadi :
    Set xlSheet = Sheet2 bValid = True

    Terima kasih suhuu atas bantuannya !! Hehe

  14. @manweljs_ pada baris :

    sName = ActiveSheet.Shapes(Application.Caller).Name
        If InStr(1, "btnSave", sName) Then
            '+-- Validasi nama sheet aktif.
            Set xlSheet = ActiveSheet
            If InStr(1, "Sheet1", xlSheet.CodeName) Then
                bValid = True
            Else
                Set xlSheet = Nothing
            End If
        End If


    edit menjadi :
    Set xlSheet = Sheet2 bValid = True

    Suhu, maaf bgt sekali lagi minta tolong, kalo misal NIP yang kita scan tidak ada di database, kita bisa menambahkannya di database selanjut nya tidak? Jadi cuma NIP sama scan IN OUT nya saja, terima kasih sebelumnya

  15. @haidaramzy ...kalo misal NIP yang kita scan tidak ada di database, kita bisa menambahkannya di database selanjut nya tidak? Jadi cuma NIP sama scan IN OUT nya saja...

    edit menjadi :

    ...
    With Sheet2
            On Error Resume Next
            r = .Range("B:B").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole).Row
            c = Target.Column
            If Err.Number Then
                r = .Range("B" & Rows.Count).End(xlUp).Row + 1
                .Cells(r, 2) = Target.Value
            End If
            Err.Clear
            If c = 3 Then
                .Cells(r, c + 3) = Now
            Else
                .Cells(r, c - 1) = Now
            End If
        End With
    ...

  16. makasih banyak suhu hehe

 

atau Mendaftar untuk ikut berdiskusi!