Demo image Demo image Demo image Demo image Demo image Demo image

Form Filter Data Export to Excel

  • Sabtu, 21 April 2012
  • Form Filter Data Export to Excel

    untuk export ke excel : project -->references -->microsoft excel 12

    Dim xls As New Excel.Application
    Dim baris As Integer
    Dim rssql As New ADODB.Recordset

    Private Sub cmbtabel_Click()
        Me.cmbkriteria.Clear
        Select Case Me.cmbtabel.Text
            Case Is = "Barang"
                Me.cmbkriteria.AddItem "Jenis"
                Me.cmbkriteria.AddItem "Nama Barang"
            Case Is = "Operator"
                Me.cmbkriteria.AddItem "Kode"
                Me.cmbkriteria.AddItem "Nama"
                Me.cmbkriteria.AddItem "Kota"
            Case Is = "Supplier"
                Me.cmbkriteria.AddItem "Kode"
                Me.cmbkriteria.AddItem "Nama"
        End Select
    End Sub



    Private Sub cmdexport_Click()
        xls.Visible = True
        xls.workbooks.Add
       
        With xls
            'tampilan
            .activecell.formulaR1C1 = "Laporan Data Barang"
            .rows("1:1").Select
            With .selection.Font
                .Name = "Calibri"
                .Size = 22
                .Strikethrough = False
                .superscript = False
                .subscript = False
                .outlinefont = False
                .shadow = False
                .Underline = xlunderlinestylenone
                .themecolor = xlthemecolorlight1
                .tintandshade = 0
                .themefont = xlthemefontminor
            End With
           
            With .selection.interior
                .Pattern = xlsolid
                .patterncolorindex = xlautomatic
                .themecolor = xlthemecoloraccent3
                .tintandshade = 0.399975585192419
                .patterntintandshade = 0
            End With
           
            With .selection.Font
                .themecolor = xlthemecolordark1
                .tintandshade = 0
            End With
            .selection.RowHeight = 33
           
            With .selection
                .horizontalalignment = xlgeneral
                .verticalalignment = xlcenter
                .WrapText = False
                .Orientation = 0
                .addindent = False
                .indentlevel = 0
                .shrinktofit = False
                .readingorder = xlcontext
                .mergecells = False
            End With
           
            'buat judul kolom tabel
            Select Case Me.cmbtabel.Text
                Case Is = "Barang"
                    .cells(3, 1) = "Kode"
                    .cells(3, 2) = "Nama Barang"
                    .cells(3, 3) = "Jenis"
                    .cells(3, 4) = "Stok"
                    .cells(3, 5) = "Harga Jual"
                    .cells(3, 6) = "Harga Beli"
                Case Is = "Operator"
                   
            End Select
           
            'export data ke excel
            n = 1
            While Not rssql.EOF
                .cells(3 + n, 1) = rssql.Fields(0)
                .cells(3 + n, 2) = rssql.Fields(1)
                .cells(3 + n, 3) = rssql.Fields(2)
                .cells(3 + n, 4) = rssql.Fields(3)
                .cells(3 + n, 5) = rssql.Fields(4)
                .cells(3 + n, 6) = rssql.Fields(5)
               
                rssql.MoveNext
                n = n + 1
            Wend
            End With
    End Sub

    Private Sub cmdproses_Click()
        Dim sqltabel As String
        Select Case Me.cmbtabel.Text
            Case Is = "Barang"
                'tampilkan data barang di grid
                If Me.txtfilter.Text = "" Then
                    xfilter$ = ""
                Else
                    If Me.cmbkriteria.Text = "Jenis" Then
                        xfilter$ = " where jenis like '%" & Me.txtfilter.Text & "%'"
                    Else
                        xfilter$ = " where nmhard like '%" & Me.txtfilter.Text & "%'"
                    End If
                End If
               
                sqltabel = "select kdhard as kode,nmhard as Nama,jenis,stok as Stok,hargabeli as Harga," & _
                "hargajual as 'Harga Jual' from hardware" & xfilter$
               
               
            Case Is = "Operator"
            'tampilkan data operator di grid
                If Me.txtfilter.Text = "" Then
                    xfilter$ = ""
                Else
                    If Me.cmbkriteria.Text = "Kode" Then
                        xfilter$ = " where kode like '%" & Me.txtfilter.Text & "%'"
                    Else
                        If Me.cmbkriteria.Text = "Nama" Then
                            xfilter$ = " where nama like '%" & Me.txtfilter.Text & "%'"
                        Else
                            xfilter$ = " where kota like '%" & Me.txtfilter.Text & "%'"
                        End If
                    End If
                End If
               
                sqltabel = "select * from operator" & xfilter$
               
           
            Case id = "Supplier"
                sqltabel = "select*from supplier"
               
               
            Case Is = "Penjualan"
           
            Case Is = "Pembelian"
                     
        End Select
       
        If rssql.State = 0 Then
            rssql.Open sqltabel, koneksi, adOpenKeyset, adLockReadOnly
        End If
        Set Me.DataGrid1.DataSource = rssql
        baris = rssql.RecordCount
    End Sub

    Sub isicombotabel()
        Me.cmbtabel.AddItem "Barang"
        Me.cmbtabel.AddItem "Operator"
        Me.cmbtabel.AddItem "Supplier"
        Me.cmbtabel.AddItem "Penjualan"
        Me.cmbtabel.AddItem "Pembelian"
    End Sub

    Private Sub Form_Load()
        isicombotabel
        buka_koneksi
    End Sub

    Private Sub exporttoexcel()
        xls.Visible = True
    End Sub
    Private Sub Form_Unload(Cancel As Integer)
        Set xls = Nothing
        Set xls = Nothing
    End Sub
    di 04.21