Select Formula Cristal Report

untuk Field berisi huruf (contoh : kode Produk, Nama Barang) :

    CRt1.SelectionFormula = "{nama_tabel.nama_field}='" + text1.text + "'"

2. untuk Field berisi angka (contoh : NIK, harga) :

    CRt1.SelectionFormula = "{nama_tabel.nama_field}=" + text1.text  + ""

3. untuk Field berisi tanggal (contoh : tanggalfaktur) :

 CRt1.SelectionFormula = "{nama_tabel.nama_field}=#" + format(DTPicker1.value,"yyyy-mm-dd")  + "#"

Apabila filter lebih dari satu tinggal menambahkan AND atau OR, contoh :

    CRt1.SelectionFormula = "{nama_tabel.nama_field}=" + text1.text  + " AND {nama_tabel.nama_field}=" + text2.text  + ""

---

tiga filter

"{Nama_Tabel.Nama_Field}= '" & Combo1.Text & "' And {Nama_Tabel.Nama_field}>=# " & TDatePicker1.Value & "# And {Nama_Tabel.Nama_field}<= #" & TDatePicker2.Value & "#"

---

‘Cara menampilkan Cristak Report Melalui Visual Basic  tanpa password

With CrystalReport1

.ReportFileName = App.Path & "\report\Laporan_Harian.rpt"

.WindowState = crptMaximized

.RetrieveDataFiles

.SelectionFormula = "{Nama_Tabel.Nama_Field}>=# " & DatePicker1.Value & "# And {Nama_Tabel.Nama_Field}<= #" & DatePicker2.Value & "#"

.Destination = crptToPrinter

.Action

End With

---

‘Cara menampilkan Cristak Report Melalui Visual Basic databse berpassword

Dim strFormula As String

   strFormula = "{TABEL1.FIELD}= '" & Combo1.Text & "'"

    With CrystalReport1

        .Destination = crptToWindow

        .SelectionFormula = IIf(Combo1.Text = "NONE", "", strFormula)

        .ReportFileName = App.Path & "\Laporan.rpt" 'assign report file

        .Password = Chr(10) & "password" 'membuka password database

        .WindowState = crptMaximized 'maximized - minimized or normal

        .DataFiles(0) = App.Path & "\Database1.mdb" 'get db current path

        .Action = 1 'show report

    End With

Ctt : Jika pada Combo1 = yang di pilih adlah NONE maka  yang di tampilkan semuanya

---

FORM LOGIN DENGAN PASSWORD BERENSKRIP (Encryption)

Besic kode adalah

Sub enskrp() 'MENGACAK DATA

Dim kalimat As String

Dim pos As Integer

  kalimat = Text1 ‘input data

  For pos = 1 To Len(kalimat)

    Mid(kalimat, pos, 1) = Chr(((Asc(Mid(kalimat, pos, 1)) * 2) \ 1) + 2)

  Next pos

  Text2 = kalimat ‘output data

End Sub

---

Sub Decrypting() 'MENGEMBALIKAN DATA DI ACAK

  Dim kalimat As String

  Dim pos As Integer

  kalimat = Text1  ‘Input data

  For pos = 1 To Len(kalimat)

    Mid(kalimat, pos, 1) = Chr((Asc(Mid(kalimat, pos, 1)) - 2) \ 2)

  Next pos

  Text2 = kalimat ‘ Output data

End Sub

Langkan pembuatan:

Seperti biasa buat project baru :

Tool yang kita gunakan adalah

-          Form

-          MDIform

-          Textbox

-          ListView1

-          ImageList1

-          Adodc1

-          DataGrid

-          StatusBar

Untuk mendapatkan tool diatas seperti basa pilih menu Project – Componen beri conteng pada

-          Microsoft Ado Data Control 6.0 (OLDB)

-          Microsoft DataGrid Contol 6.0 (OLDB)

-          Microsoft Window Common Control 6.0 (SP6)

 Buat Rancangan form Sebagai berikut

 

Properti : Form

TOOL	PRPERTIS	NAME
Form	BorderStyle : FixedSingle StartUpPosition : ScreenSenter MDChil = False	Form1
Form	BorderStyle : FixedSingle MDChil = True	Form2
Form	BorderStyle : FixedSingle MDChil = True	Form3
MDIForm	Windowsate : Maxsimized	MDIForm1

Code Form Login :

Option Explicit

Public conn As New ADODB.Connection

---

Public Function OpenConnection() As Boolean

On Error GoTo ErrHandler

    Dim strCon As String

    strCon = "PROVIDER=MSDataShape;Data PROVIDER= microsoft.jet.oledb.4.0;Data Source=" _

& App.Path & "\Database.mdb;Jet OLEDB:Database Password=rahman; "

    Set conn = New ADODB.Connection

    conn.ConnectionString = strCon

    conn.Open

    OpenConnection = True

    Exit Function

ErrHandler:

    OpenConnection = False

End Function

---

Sub enskrp() 'MENGACAK PASWORD

Dim kalimat As String

Dim pos As Integer

  kalimat = Text2

  For pos = 1 To Len(kalimat)

    Mid(kalimat, pos, 1) = Chr(((Asc(Mid(kalimat, pos, 1)) * 2) \ 1) + 2)

  Next pos

  Text3 = kalimat

End Sub

---

Private Sub Command1_Click()

enskrp

Adodc1.Recordset.Find "USER_NAME='" + Text1.Text + "'", , adSearchForward, 1

If Not Adodc1.Recordset.EOF Then

If (Text1.Text = Adodc1.Recordset!USER_NAME) And (Text3.Text = Adodc1.Recordset!PWD) Then

MDIForm1.Show

Unload Me

Else

    MsgBox ("Nama User dan Password yang anda masukin salah"), vbInformation, "Wrong...."

End If

End If

End Sub

---

Private Sub Form_Load()

OpenConnection

Adodc1.ConnectionString = conn.ConnectionString

Adodc1.RecordSource = "LOGIN"

Set DataGrid1.DataSource = Adodc1

End Sub

 

Cara Seting ListView1 Click kana pada ListView1 akam Muncul Properti Pages

Click Tab Clom Heder

Click – Inser Colom

Colon Name	Size
USER NAME	3440.12
CREATED	1940.03
MODIFIY	1940.03

Pada Tab Emage lists

Pada Normal dan Small ganti dari <none> menjadi ImageList1
catan : ImageList sudah anda sispkan ke Form

Code Programnya:

Option Explicit

Dim Db As Connection

Dim Database As Connection

Dim WithEvents rs As Recordset

---

Sub konek()

Set Database = Nothing

Set Database = New Connection

Database.CursorLocation = adUseClient

Database.Open "PROVIDER=MSDataShape;Data PROVIDER= microsoft.jet.oledb.4.0;Data Source=" _

& App.Path & "\Database.mdb;Jet OLEDB:Database Password=rahman; "

End Sub

---

Private Sub IsiList_From_Tabel()

Dim itmnew As ListItem

ListView1.ListItems.Clear

If Adodc1.Recordset.RecordCount = 0 Then Exit Sub

Adodc1.Recordset.Requery

Adodc1.Recordset.MoveFirst

Do While Not Adodc1.Recordset.EOF

    If Adodc1.Recordset.EOF Then Exit Sub

With ListView1

   Set itmnew = .ListItems.Add(, , Adodc1.Recordset.Fields("USER_NAME"), 1, 1)

    itmnew.SubItems(1) = Adodc1.Recordset.Fields("CREATED")

    itmnew.SubItems(2) = Adodc1.Recordset.Fields("MODIFY")

End With

Adodc1.Recordset.MoveNext

Loop

End Sub

---

Sub enskrp() 'MENGACAK PASWORD

Dim kalimat As String

Dim pos As Integer

  kalimat = Text2

  For pos = 1 To Len(kalimat)

    Mid(kalimat, pos, 1) = Chr(((Asc(Mid(kalimat, pos, 1)) * 2) \ 1) + 2)

  Next pos

  Text3 = kalimat

End Sub

---

Private Sub CmdAddUser_Click()

enskrp

With Adodc1.Recordset

.AddNew

!USER_NAME = Text1.Text

!PWD = Text3.Text

!CREATED = Date

!MODIFY = Date

End With

IsiList_From_Tabel

MsgBox "Uset telah berhasil di Tambahkan !", vbInformation + vbOKOnly

Text1.Text = ""

Text2.Text = ""

Text3.Text = ""

End Sub

---

Private Sub CmdCancel_Click()

Unload Me

End Sub

---

Private Sub Form_Load()

Me.Left = (Screen.Width - Me.Width) / 2

Me.Top = 1000

konek           'memanggil prosedure coneksi string

Adodc1.ConnectionString = Database.ConnectionString

Adodc1.RecordSource = "LOGIN"

Set DataGrid1.DataSource = Adodc1

IsiList_From_Tabel

End Sub

---

 

Code Programnya

Option Explicit

Dim Database As Connection

Dim WithEvents rs As Recordset

---

Sub konek()

Set Database = Nothing

Set Database = New Connection

Database.CursorLocation = adUseClient

Database.Open "PROVIDER=MSDataShape;Data PROVIDER= microsoft.jet.oledb.4.0;Data Source=" _

& App.Path & "\Database.mdb;Jet OLEDB:Database Password=rahman; "

End Sub

---

Sub enskrp() 'MENGACAK PASWORD

Dim kalimat As String

Dim pos As Integer

  kalimat = Text4

  For pos = 1 To Len(kalimat)

    Mid(kalimat, pos, 1) = Chr(((Asc(Mid(kalimat, pos, 1)) * 2) \ 1) + 2)

  Next pos

  Text5 = kalimat

End Sub

---

Sub Decrypting() 'MENGEMBALIKAN PASWORD YANG DI ACAK

  Dim kalimat As String

  Dim pos As Integer

  kalimat = Adodc1.Recordset.Fields("PWD")

  For pos = 1 To Len(kalimat)

    Mid(kalimat, pos, 1) = Chr((Asc(Mid(kalimat, pos, 1)) - 2) \ 2)

  Next pos

  Text3 = kalimat

End Sub

---

Private Sub Command1_Click()

Adodc1.Recordset.Find "USER_NAME='" + Text1.Text + "'", , adSearchForward, 1

If Not Adodc1.Recordset.EOF Then

Decrypting

'-------------------MEMBANDINGKAN PASSWORD LAMA-----------------------

    If Text3.Text <> Text2.Text Then

        MsgBox "Error Proses, Old Password in falid!", vbCritical

    Else

        enskrp

        With Adodc1.Recordset

        !USER_NAME = Text1.Text

        !PWD = Text5.Text

        !MODIFY = Date

        .Update

        End With

        MsgBox "password success at change ! ", vbInformation + vbOKOnly

        Text1.Text = ""

        Text2.Text = ""

        Text3.Text = ""

        Text4.Text = ""

        Text5.Text = ""

    End If

Else

MsgBox "Error Proses, Data not fund!", vbCritical

End If

End Sub

---

Private Sub Command2_Click()

Unload Me

End Sub

---

Private Sub Form_Load()

Me.Left = (Screen.Width - Me.Width) / 2

Me.Top = 1000

konek           'memanggil prosedure coneksi string

Adodc1.ConnectionString = Database.ConnectionString

Adodc1.RecordSource = "LOGIN"

Set DataGrid1.DataSource = Adodc1

End Sub

---

Download Artikel Lengkanya : Cara Membuat Form Login dengan Paswword di Enskrip
Download Source Codenya :Login_Enskrip&Diskripting.rar

Cara Membuat Tanggal Awal & Akhir pada Laporan Dengan Cristal Report

Plih menu Inset – Grand total 

Pilih Field Tanggal  

Pada Insert a Field which calcolate the  pilih

Maximun : Untuk mencari nilai tertinggi (Tanggal terbaru/ tanggal awal)

Minimum : Untuk mencari nilai terendah (Tanggal lama / Tanggal Akhir)

OK

Membuat Mencari Tanggal Maksimal dan Minimal Cara 2

Pilh menu Insert Field Object

Plih Formula Field – Click Kana NEW

Pada Formula Name Isikan nama Formul (Ex: MinTGL) – OK

Pilh Funcitions – Summary – Minimum(Fld)

Pilh Field yang ingin di cari niali minimumnya

Atau ketikan kode berikut

Minimum ({Nama_Tabel.Nama_Field})

 

Fungsi tool Furmula Editor

 

Membuat group

Pilh menu Inset Grup

Pada Inser Group Dialog pilih Field Primarykey-nya - OK

 

Ctt :Jika anda ingin membuat grup Tanggal pilih Field tanggal

 

Untuk membuat sub total anda tinggal pilih menu Inser –SubTotal

 

Hasilya

Download juga :Cara membuat Database Acces Berpassword dengan MD Office 2010
Donload Articel Nya di Sini : VB6.0 & CR 8.5 dengan DB Acces Berpassword

Halamab Berhubunga dengan : Cara Menjalankan Cristal Repot di VB6.0

SAVE PICTURE KE DATABASE BERPASSWORD DAN MEMBUAT LAPORANYA

Untuk Menyimpan Picture ke database  kita perlu meload file (msado27.tlb)

Carana

Aktifkan Visual Basic anda

Buat prpject baru dengan nama terserah anda

Pilih menu Project – Preferent

      Beri Conteng pada Microsoft AktiveX Data Object 2.7 Library - OK

 

-       Pilih lagi menu Project – Componen – beri conteng pada

-       Microsoft ADO Data Control 6.0 (OLDB)

-       Microsoft  DataGrid Control 6.0 (OLDB)

-       Microsoft Common  Dialog Control 6.0 (SP 6)

setelah itu buat rancangan form sebagai berikut

 

Tool  yang digunakan:

1.    Text Box

2.    Command Botton

3.    Image

4.    Adodc

5.    DataGrid

6.    Commad Dialog

7.    Cristal Report Control

Code Programnya :

Option Explicit

Dim RsImg As ADODB.Stream

Dim Vimg As Boolean

Dim Url_Image As String

'-------------------

Dim Database As Connection

Dim WithEvents rs As Recordset

---

Sub konek()

Set Database = Nothing

Set Database = New Connection

Database.CursorLocation = adUseClient

Database.Open "PROVIDER=MSDataShape;Data PROVIDER= microsoft.jet.oledb.4.0;Data Source=" _

& App.Path & "\Database1.mdb;Jet OLEDB:Database Password=rahman; " ' path DB & password databse

End Sub

---

Private Sub Command1_Click() 'broese file foto

cd1.ShowOpen

cd1.Filter = "Image (*.jpg)|*.jpg" 'menyaring agar object yang tampil pada commad dialg hanya file JPG

Url_Image = cd1.FileName

Image1.Picture = LoadPicture(Url_Image)

Vimg = True

End Sub

---

Private Sub Command3_Click() 'Save

If Text1.Text = "" Then 'Jika no kosong

MsgBox "Nomor Harus di isi !", vbCritical

Text1.SetFocus

Exit Sub

End If

If Text2.Text = "" Then ' jika nama kosong

MsgBox "Nama harus di isi !", vbCritical

Text2.SetFocus

Exit Sub

End If

If Text3.Text = "" Then 'jika alamat kosong

MsgBox " Alamat harus di isi !", vbCritical

Text3.SetFocus

Exit Sub

End If

'------------------------------ -------------------------------------

With Adodc1.Recordset

    .AddNew

     .Fields("NO") = Text1.Text

     .Fields("NAMA") = Text2.Text

     .Fields("ALAMAT") = Text3.Text

           

    ' code berikut berfungsi untuk menyimpan data gambar ke database

    RsImg.LoadFromFile (Url_Image)

    Adodc1.Recordset!FOTO = RsImg.Read

    Adodc1.Recordset.Update

    Adodc1.Recordset.Close

            MsgBox "Data baru berhasil disimpan ", _

            0 + vbInformation, "Input Data Baru"    'pesan tersimpan

End With

Adodc1.Refresh

DataGrid1.Refresh

Url_Image = "" 'mengosongkan fileName

Adodc1.Caption = "Count  : " & Adodc1.Recordset.RecordCount & "      Tabel :" & Adodc1.RecordSource

End Sub

---

Private Sub Command4_Click() 'Edit

If Command4.Caption = "Edit" Then

   Command4.Caption = "Update"

   Url_Image = ""  'mengosongkan fileName

Else

'------------------------------------------------------------------------------------

If Url_Image = "" Then

If MsgBox("Apakah anda ingin mengganti Picture? ", vbQuestion + vbYesNo) = vbYes Then

Call Command1_Click 'memanggil tombol browse

Else

Url_Image = (App.Path + "\temp.jpg") ' meload image dari temp

End If

End If

'----------------------------------------------------------------------------------

With Adodc1.Recordset

     .Fields("NO") = Text1.Text

     .Fields("NAMA") = Text2.Text

     .Fields("ALAMAT") = Text3.Text

           

    ' code berikut berfungsi untuk menyimpan data gambar ke database

    RsImg.LoadFromFile (Url_Image)

    !FOTO = RsImg.Read

    .Update

    .Close

            MsgBox "Data berhasil diperbaharuai ", _

            0 + vbInformation, "Input Data Baru"  ' Pessan Kosong

End With

Adodc1.Refresh

DataGrid1.Refresh

Url_Image = ""

Command4.Caption = "Edit"

Adodc1.Caption = "Count  : " & Adodc1.Recordset.RecordCount & "      Tabel :" & Adodc1.RecordSource

End If

End Sub

---

Private Sub Command5_Click() 'Hapus

Dim X As String

'Buat pernyatanya sebelum dihapus

X = MsgBox(("Anda yakin Mau Menghapus data ini ? " + Chr(13) + _

            "" + Chr(13) + _

            "NAMA = " + Adodc1.Recordset!NAMA), vbYesNo + vbCritical) ' menampilkan nama pada MesageBOx

   If X = vbYes Then

   On Error Resume Next

        Adodc1.Recordset.Delete

  End If

Adodc1.Caption = "Count  : " & Adodc1.Recordset.RecordCount & "      Tabel :" & Adodc1.RecordSource

End Sub

---

Private Sub DataGrid1_Click()

On Error Resume Next

If Not Adodc1.Recordset.EOF Then

    RsImg.Write (Adodc1.Recordset!FOTO)

    RsImg.SaveToFile (App.Path + "\temp.jpg"), adSaveCreateOverWrite 'menyimpan image ke library dengan file Temp.jpg

    Set Image1.Picture = VB.LoadPicture(App.Path + "\temp.jpg") 'menampilakn gambar ke tool Image

    Text1.Text = Adodc1.Recordset!NO

    Text2.Text = Adodc1.Recordset!NAMA

    Text3.Text = Adodc1.Recordset!ALAMAT

End If

End Sub

---

Private Sub Form_Load()

konek           'memanggil prosedure coneksi string

Adodc1.ConnectionString = Database.ConnectionString

Adodc1.RecordSource = "TABEL1"

Set DataGrid1.DataSource = Adodc1

Set RsImg = New ADODB.Stream

RsImg.Type = adTypeBinary

RsImg.Open

Adodc1.Caption = "Count  : " & Adodc1.Recordset.RecordCount & "      Tabel :  " & Adodc1.RecordSource

End Sub

---

Private Sub Form_Unload(Cancel As Integer)

Kill (App.Path + "\temp.jpg") 'menghapus foto pada libray ketika form exit

End Sub

---

 

Code Programnya :

Option Explicit

Dim rsPerson As New ADODB.Recordset

Public conn As New ADODB.Connection

---

Public Function OpenConnection() As Boolean

On Error GoTo ErrHandler

    Dim strCon As String

    strCon = "PROVIDER=MSDataShape;Data PROVIDER= microsoft.jet.oledb.4.0;Data Source=" _

& App.Path & "\Database1.mdb;Jet OLEDB:Database Password=rahman; "

    Set conn = New ADODB.Connection

    conn.ConnectionString = strCon                                                                 

    conn.Open

    OpenConnection = True

    Exit Function

ErrHandler:

    OpenConnection = False

End Function

---

Private Sub Command1_Click()

 Dim strFormula As String

   strFormula = "{TABEL1.NO}= '" & Combo1.Text & "'"

    With CrystalReport1

        .Destination = crptToWindow

        .SelectionFormula = IIf(Combo1.Text = "NONE", "", strFormula)

        .ReportFileName = App.Path & "\BIODATA.rpt" 'assign report file

        .Password = Chr(10) & "rahman" 'membuka password database

        .WindowState = crptMaximized 'maximized - minimized or normal

        .DataFiles(0) = App.Path & "\Database1.mdb" 'get db current path

        .Action = 1 'show report

    End With

End Sub

---

Private Sub Command2_Click()

Unload Me

End Sub

---

Private Sub Form_Load()

OpenConnection

'====================MENGISI PILIHAN PADA COMBOBOX NOMOR =====================

   Combo1.AddItem "NONE"

    rsPerson.Open "select * from TABEL1", conn

    Do While Not rsPerson.EOF

        Combo1.AddItem rsPerson!NO

        rsPerson.MoveNext

    Loop

    If rsPerson.State <> adStateClosed Then

        rsPerson.Close

    End If

End Sub

---

Private Sub Form_Unload(Cancel As Integer)

   If rsPerson.State <> adStateClosed Then

        rsPerson.Close

    End If

    Set rsPerson = Nothing

    If conn.State <> adStateClosed Then

        conn.Close

    End If

    Set conn = Nothing

End Sub

---

Selamat Belajar

Download Artikelnya : Save Picture Ke Database Berpassword 

Donload Sampel Projectnya : Save Picture Db Acces Berpassword