Membuat Expire Pemakaian Userform

  1. 3 tahun lalu

    halo para mastah
    problem : membuat expire penggunaan userform setelah x hari
    kalo pake tanggal sudah berhasil:

    Private Sub UserForm_Activate()
    expired = DateSerial(2015, 7, 1)
    If Date >= expired Then
    MsgBox "Maaf!Sudah expired", vbOKOnly
    Application.Quit
    End If
    End Sub

    yang belum berhasil pake jumlah hari:

    Private Sub UserForm_Activate()
    Dim firstDate As Date, secondDate As Date

    firstDate = Date
    secondDate = DateAdd("d", 1, firstDate)
    If Date >= secondDate Then
    MsgBox "Maaf!Sudah expired", vbOKOnly
    Application.Quit
    End If
    End Sub

    mohon koreksinya para mastah, terima kasih

  2. Masdad

    30 Jul 2015 Terverifikasi Demak + 611 Poin

    Mungkin bisa menempatkan Tgl Expired di sel tertentu misal contoh pada Sel A1 Sheet 1.
    Penulisan Scriptnya pada contoh berikut saya letakkan di Workbook_Open tinggal di modifikasi saja dimana ingin meletakkan scriptnya nanti:

    Private Sub Workbook_Open()
        If Sheet1.Range("A1") = "" Then
           Sheet1.Range("A1") = Date + 30 '<-- di isi 30 ( jika trial 30 hari)
           ThisWorkbook.Save
        ElseIf Sheet1.Range("A1") <= Date Then
            MsgBox "Mohon Maaf Masa Trial Sudah Habis Bro :)" & vbNewLine & _
            "Silahkan Hubungi Admin BelajarExcel.org", vbCritical, "Expired"
            Application.Quit
        ElseIf Sheet1.Range("A1") - Date <= 30 Then '<-- di isi 30 ( jika trial 30 hari)
            MsgBox "Masa Trial / Percobaan tinggal " & Sheet1.Range("A1") - Date & " hari lagi Bro...", vbInformation, "Info Penting"
        End If
    End Sub


    Penjelasan Scriptntya:
    Script akan dijalankan begitu Workbook di buka.

    Private Sub Workbook_Open()
       ...........
    End Sub


    Jika Sel A1 pada Sheet 1 tidak ada isinya / kosong maka akan di isi dengan Format tanggal 30 hari dari hari ini, Anda bisa mengganti 30 dengan jumlah hari maks trial aplikasi anda.
    Setelah itu Workbook akan disimpan.

    If Sheet1.Range("A1") = "" Then
           Sheet1.Range("A1") = Date + 30 '<-- di isi 30 ( jika trial 30 hari)
           ThisWorkbook.Save


    Jika Sel A1 pada Sheet 1 berisi tanggal maka akan periksa apakah tanggal pada Sel A1 Sheet 1 tersebut lebih kecil atau sama dengan tanggal hari ini, jika ya (True) Maka Pesan Expired akan di tampilkan kemudian Workbook akan otomatis di tutup.

        ElseIf Sheet1.Range("A1") <= Date Then
            MsgBox "Mohon Maaf Masa Trial Sudah Habis Bro :)" & vbNewLine & _
            "Silahkan Hubungi Admin BelajarExcel.org", vbCritical, "Expired"
            Application.Quit


    Jika Tanggal pada Sel A1 kurang dari 30 hari dari tanggal sekarang maka akan tampil pesan Trial, Jika lebih dari 30 hari maka tidak ada pesan apapun yang tampil.

    ElseIf Sheet1.Range("A1") - Date <= 30 Then '<-- di isi 30 ( jika trial 30 hari)
            MsgBox "Masa Trial / Percobaan tinggal " & Sheet1.Range("A1") - Date & " hari lagi Bro...", vbInformation, "Info Penting"

    Silahkan di kembangkan....

  3. 2 tahun lalu

    ijin gan, pengguna baru :)

  4. tahun lalu

    Selamat siang mas, saya ingin mengetahui bagaimana cara meng aktifkan file excell menggunakan expired date, jika lewat dari tanggal yang di tentukan maka dia akan tertutup dengan sendirinya. Di internet sudah saya coba tapi cuma berfungsi di komputer saya di karenakan saya mengaktifkan semua fitur macro nya,
    Sedangkan di komputer lain scrip expired date nya tidak berfungsi sama sekali...
    mohon pencerahannya

  5. klo misalkan ada beberapa sheet gmn scrib x om..trus jga ketika menggunakan pada thisworkbook ngga bsa..

    karena sdh terisi pada thisworkbook scrib ini...
    private sub workbook_open ()
    application.visible=false
    uf1.show
    end aub..

  6. Caton

    14 Nov 2017 Terverifikasi Indonesia + 12.574 Poin

    @Rudy Tirawan:

    Inti dari skrip kode VBA mas @Masdad di atas khan menguji masa Trial dari aplikasi dimana informasi masa Trial disimpan pada Sheet1. Jadi tidak ada masalah jika dalam Workbook ada banyak Worksheet. Buat sebuah sheet khusus untuk menyimpan informasi Trial tersebut, atau gunakan sel tertentu pada sheet yang sudah ada. Misalkan pada Workbook (file) sudah ada sheet Data (misalkan nama VBA Objeknya Sheet5), dimana range A1:Z1000 digunakan untuk menyimpan data utama, dan data masa Trial akan disimpan pada sel A10000, maka rujukannya menjadi:

    Sheet5.Range("A10000")

    Lalu bagaimana jika pada prosedur Workbook_Open() sudah ada skrip:

    Private Sub Workbook_Open()
        Application.Visible = False
        uf1.Show
    End Sub

    Menurut saya tidak ada masalah. Modifikasi kode programnya menjadi:

    Private Sub Workbook_Open()
        Application.Visible = False
    
        If Sheet1.Range("A1") = "" Then
           Sheet1.Range("A1") = Date + 30 '<-- di isi 30 ( jika trial 30 hari)
           ThisWorkbook.Save
        ElseIf Sheet1.Range("A1") <= Date Then
            MsgBox "Mohon Maaf Masa Trial Sudah Habis Bro :)" & vbNewLine & _
            "Silahkan Hubungi Admin BelajarExcel.org", vbCritical, "Expired"
            Application.Quit
        ElseIf Sheet1.Range("A1") - Date <= 30 Then '<-- di isi 30 ( jika trial 30 hari)
            MsgBox "Masa Trial / Percobaan tinggal " & Sheet1.Range("A1") - Date & " hari lagi Bro...", vbInformation, "Info Penting"
        End If
    
        uf1.Show
    End Sub

    Dari baris kode di atas, prosesnya akan menyembunyikan jendela aplikasi Excel dahulu dan kemudian memeriksa masa Trial. Aplikasi akan ditutup (Application.Quit) jika masa Trial sudah habis. Jika Workbook baru dijalankan, maka data masa Trial akan disimpan dahulu atau jika sudah pernah digunakan maka apalikasi akan menampilkan pesan sisa masa Trial, selanjutnya UserForm UF1 kemudian ditampilkan. Demikian menurut saya... ;)

  7. klo di workbook gmn pak scrib x..klo itukan cma satu sheesheet..seandaex lbih dri satu sheet gmn???mff baru belajar pak

  8. ok pak dicoba dludlu..sbelumnya trima kasih atas bimbingan x

  9. Tested OK, cocok nich ...
    Ijin sedot master ...

  10. 11 bulan yang lalu

    Ijin menggunakan kodenya ya Master @Masdad ... Berjalan dgn mulus kodenya

 

atau Mendaftar untuk ikut berdiskusi!