Membuat generator key dengan Macro VBA Excel

Saat di kantor malas, coba-coba main form di Ms. excel dengan memanfaatkan fitur macro ...e..... gak tau sampai kepikiran membuat Generator Key yang membaca SN-Drive.....up......dari pada kelamaan langsung saja ....kira2 ini tampilannya saat dibuka

 

gambar. 1

1. Pertama : buka Excel ganti nama sheet menjadi serial, buka macro vba buat 1 interface form seperti gambar diatas
2. kedua : insert label1, label2, tetx1,text2, button1,button2, button3 dan scrool bar

         kemudian ganti caption seperti berikut :

         caption label1       = SN-DRIVE REGISTRASI

         caption label2       = KODE AKTIVASI

         caption label3       = <----Play

         name text1           = txtReg

         name text2           = txtSerial

         caption button1    = GENERATOR

         name button1       = cmdPutar

         caption button2    = ABOUT

         name button2       = cmdAbout

         caption button3    = EXIT

         caption button3    = cmdExit

         name scrool bar   = DATAS

    3.  Kemudian klik Scrool Bar 

         Masukkan string : Private Sub DATAS_Change()
                       If DATAS.Value Then Call ApdetKontrol
                 End Sub

    4.  klik About

         Masukkan string : Private Sub cmdAbout_Click()
    MsgBox "                              GENERATOR KEY " & vbCrLf _
            & "                           Versi. 0.1" & vbCrLf & vbCrLf _
            & "   ===============================" & vbCrLf _
            & "   Ini contoh membuat serial number" & vbCrLf _
            & "   Dengan mengoptimalkan Macro VBA Project  " & vbCrLf _
            & "   Aplikasi masih dibawah kesempurnaan" & vbCrLf _
            & "   ===============================" & vbCrLf & vbCrLf _
            & "   By. wahyuareta" & vbCrLf _
            & "   http://packfile.webs.com" & vbCrLf & vbCrLf _
            & "   Support Mas Syukron. Thank's ", vbOKOnly, "ABOUT"
    End Sub

    5.  Klik  cmdPutar

         Masukkan string :

         Private Sub cmdPutar_Click()
          Dim BarisAktip As Integer
                  BarisAktip = DATAS.Value
                     With ThisWorkbook.Sheets("Serial")
                       .Cells(BarisAktip, 1).Value = txtReg.Value
                        End With
    txtSerial.Value = ThisWorkbook.Sheets("Serial").Cells(DATAS.Value, 2)
    End Sub

     6. Insert module..

         masukkan kode berikut :

         Private Function Generator(KodeNumber As Long) As String

        Dim Digit10 As Variant
        Dim i As Integer
        Dim karakter(15) As Variant
             karakter(0) = "F"
             karakter(1) = "5"
             karakter(2) = "P"
             karakter(3) = "X"
             karakter(4) = "V"
             karakter(5) = "8"
             karakter(6) = "E"
             karakter(7) = "Y"
             karakter(8) = "4"
             karakter(9) = "W"
             karakter(10) = "Y"
             karakter(11) = "G"
             karakter(12) = "O"
             karakter(13) = "Z"
             karakter(14) = "R"
             karakter(15) = "9"
       
          Digit10 = Right("1234567890" & KodeNumber, 4)
          Do
           If Len(Digit10) >= 10 Then Exit Do
               Digit10 = Digit10 * KodeNumber
          Loop
          For i = 1 To 10
             Generator = Generator & karakter(Mid(Digit10, i, 1))
          Next i
      End Function

       7.   Tambahkan string berikut :

            'ini untuk menampikan key

            Private Sub DATAS_Change()
                   If DATAS.Value Then Call ApdetKontrol
            End Sub   

           ----------------------------------------------------------------------------------------------------------
            Private Sub ApdetKontrol()
                       txtReg.Value = ThisWorkbook.Sheets("Serial").Cells(DATAS.Value, 1)
                txtSerial.Value = ThisWorkbook.Sheets("Serial").Cells(DATAS.Value, 2)
              End Sub
          ----------------------------------------------------------------------------------------------------------
            Private Sub UserForm_Activate()
             Me.Caption = "GENERATOR KEY" ' ini untuk memberi caption form
      
            End Sub

         -----------------------------------------------------------------------------------------------------------

        ' string ini untuk menanaktifkan closed
             Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
             If CloseMode = vbFormControlMenu Then
                         Cancel = True
                     MsgBox "Maaf silahkan pilih tombol exit untuk keluar!"
                      End If
             End Sub
      
       ---------------------------------------------------------------------------------------------------------------

       Pada workbook masukkan string :

      Option Explicit

      Private Sub Workbook_Deactivate()
      Application.Visible = True
   
     End Sub

      Private Sub Workbook_Open()
    Application.Visible = False
    UserForm1.Show
    Application.Visible = True

    End Sub

selamat mencoba....

Bila ingin jadinya silahkan unduh : KEY SERIAL jangan lupa like
Password VBA : kontakpm4x

Silahkan dimodifikasi bebas tetap sertakan sumber aslinya

BERLANJUT KE BAGIAN KE 2
Membuat Registrasi Key