Filter Photo dalam Laporan

Penyajian Photo dalam Laporan

Deskripsi Aplikasi:  Aplikasi yang dibuat untuk menyajikan informasi dari ditel barang beserta foto dari barang tersebut agar menjadi jelas, " Kayak Begini Lho Barangnya ". Dan dengan demikian diharapkan yang menerima laporan/cetakan barang tersebut menjadi lebih dipastikan dengan cetakan tersebut. 

Kekurangan:  Aplikasi ini tidak bisa memilih kembali setelah laporan/cetakan tersebut ditutup. Dan diharapkan bantuannya untuk perbaikan program dengan jalan lewat komentar/by e-mail. 

Project:  

 1.  Siapkan dua buah Form:

      a. Pada Form1 Name frmPrint

          - ComboBox Name cmb

          - CommandButton Name CmdPrint

     b. Pada Form2 Name frmReport

          - CRViewer1 Name CRViewer1
     c. Module
     d. Crystal Report Name katalok.rpt

2. Interface-SourceCode
  a. frmPrint

Code:
Option Explicit
Private Sub cmdPrint_Click()
frmReport.WindowState = 2
frmReport.Show 1
'Unload Me
End Sub
Private Sub Form_Load()
Dim rsp As ADODB.Recordset
'Set rsp = New ADODB.Recordset
If OpenDatabase = False Then
    Unload Me
    Exit Sub
Else
    Set rsp = cn.Execute("select filename from LP")
    Do While Not rsp.EOF
        Cmb.AddItem rsp(0)
        rsp.MoveNext
    Loop
End If
End Sub

b.frmReport

Code:
Option Explicit
Dim rpt As CRAXDRT.Report
Dim db As CRAXDRT.Database
Dim rs As New ADODB.Recordset
Dim WithEvents sect As CRAXDRT.Section
Private Sub Form_Load()
Screen.MousePointer = vbHourglass
Set rpt = crx.OpenReport(App.Path & "\Report\katalok.rpt")
Set db = rpt.Database
Set sect = rpt.Sections("Section5")
rs.Open "SELECT * FROM LP where FileName = '" & frmPrint.Cmb.Text & "'", cn, 1, 1
rpt.Database.SetDataSource rs, 3, 1
CRViewer1.ReportSource = rpt
CRViewer1.ViewReport
CRViewer1.Zoom 1
Screen.MousePointer = vbDefault
End Sub
Private Sub Form_Resize()
CRViewer1.Top = 0
CRViewer1.Left = 0
CRViewer1.Height = ScaleHeight
CRViewer1.Width = ScaleWidth
End Sub
Private Sub Form_Unload(Cancel As Integer)
'cn.Close
End Sub
Private Sub sect_Format(ByVal pFormattingInfo As Object)
Dim bmp As StdPicture
On Error Resume Next
With sect.ReportObjects
    Set .Item("picCake").FormattedPicture = LoadPicture(App.Path & "\LP\LP.jpg") 'default
    If .Item("adoFileName").Value <> "" Then
        Set bmp = LoadPicture(App.Path & "\LP\" & .Item("adoFileName").Value)
        Set .Item("picCake").FormattedPicture = bmp
    End If
End With
End Sub

c. Module

Option Explicit
Public cn As ADODB.Connection
Public crx As New CRAXDRT.Application
Public Function OpenDatabase() As Boolean
On Error GoTo checkErr
Set cn = New ADODB.Connection
cn.Provider = "Microsoft.Jet.OLEDB.4.0"
cn.ConnectionString = "Data Source=" & App.Path & "\Data\DBLP.mdb"
cn.Properties("Jet OLEDB:Database Password") = "sulikan"
cn.Open
OpenDatabase = True
Exit Function
checkErr:
MsgBox Err.Description, vbExclamation, Err.Number
End Function

d.Design Crystal Report

===== Downloads =====

NB: Perbaikan, Saran, Komentar