Tips Kali ini, akan menampilkan data dari Microsoft Acces 2000 ke Visual Basic 2008 lalu data di Export dan ditampikan menggunakan Grafik Microsoft Excel 2007. Tampilan data yang akan di Export seperti pada gambar di atas. Hasil tampilan Pada Excel 2007 seperti gambar di bawah ini:
ToolBox yang digunakan sebagai berikut:
Design Form dari ToolBox di atas seperti gambar di bawah ini:
Ketiklah source program di bawah ini, dengan mengarahkan kursor pada design, mengklik kanan lalu pilih View Code.
Source Program:
Listing program pada class DataBaseConnection:
Imports System.Data
Imports System.Data.OleDb
Namespace AccessData
Public Class DataBaseConnection
Dim conect As New OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + Application.StartupPath + "\Data.mdb;") 'OleDbConnection From Microsoft
Public Function open() As OleDbConnection
conect.Open()
Return conect
End Function
Public Function close() As OleDbConnection
conect.Close()
Return conect
End Function
End Class
End Namespace
Listing program pada design Form:
Imports System.Data
Imports System.Data.OleDb
Imports System.IO
Imports Microsoft.Office.Interop
Public Class Form1
Inherits System.Windows.Forms.Form
Dim objConnection As OleDbConnection
Dim objCommand As OleDbCommand
Dim objDataAdapter As OleDbDataAdapter
Dim strSQL As String
Dim objDataSet As New DataSet
Dim objDataTable As New DataTable
Dim MyConnection As New AccessData.DataBaseConnection
Dim AlphaNum As Integer
Dim Filename, Alphabets As String
Dim chkexcel As Boolean
Dim oexcel As Excel.Application
Dim obook As Excel.Workbook
Dim osheet As Excel.Worksheet
Sub Alphabet()
Select Case AlphaNum
Case 1
Alphabets = "A"
Case 2
Alphabets = "B"
Case 3
Alphabets = "C"
Case 4
Alphabets = "D"
Case 5
Alphabets = "E"
Case 6
Alphabets = "F"
Case 7
Alphabets = "G"
Case 8
Alphabets = "H"
Case 9
Alphabets = "I"
Case 10
Alphabets = "J"
Case 11
Alphabets = "K"
Case 12
Alphabets = "L"
Case 13
Alphabets = "M"
Case 14
Alphabets = "N"
Case 15
Alphabets = "O"
Case 16
Alphabets = "P"
Case 17
Alphabets = "Q"
Case 18
Alphabets = "R"
Case 19
Alphabets = "S"
Case 20
Alphabets = "T"
Case 21
Alphabets = "U"
End Select
End Sub
Sub Dbclose()
REM mengecek dan tutup excel application
If chkexcel = True Then
osheet = Nothing
oexcel.Application.DisplayAlerts = False
obook.Close()
oexcel.Application.DisplayAlerts = True
obook = Nothing
oexcel.Quit()
oexcel = Nothing
End If
REM End
End Sub
Sub Generate_Sheet()
View_Data()
osheet = oexcel.Worksheets(1)
REM Menganti nama Sheet
osheet.Name = "Excel Charts"
osheet.Range("A1:AZ400").Interior.ColorIndex = 2
osheet.Range("A1").Font.Size = 12
osheet.Range("A1").Font.Bold = True
osheet.Range("A1:I1").Merge()
osheet.Range("A1").Value = "Daftar Nilai Excel Automation With Charts"
osheet.Range("A1").EntireColumn.AutoFit()
REM columns(heading)
For i As Integer = 0 To objDataTable.Columns.Count - 1
AlphaNum = i + 1
Alphabet()
osheet.Range(Alphabets & "3").Value = objDataTable.Columns.Item(i).ToString
osheet.Range(Alphabets & "3").BorderAround(8)
osheet.Range(Alphabets & "3").EntireColumn.AutoFit()
Next
REM format(headings)
osheet.Range("A3:" & Alphabets & "3").Font.Color = RGB(255, 255, 255)
osheet.Range("A3:" & Alphabets & "3").Interior.ColorIndex = 5
osheet.Range("A3:" & Alphabets & "3").Font.Bold = True
osheet.Range("A3:" & Alphabets & "3").Font.Size = 10
REM memasukkan data dari DB
Dim R As Integer = 3
REM Dim x As Integer
For Each row As DataRow In objDataTable.Rows
R = R + 1
For i As Integer = 0 To objDataTable.Columns.Count - 1
AlphaNum = i + 1
Alphabet()
osheet.Range(Alphabets & R).Value = row(i).ToString
osheet.Range(Alphabets & R).BorderAround(8)
Next i
Next
REM Membuat object chart
Dim oChart As Excel.Chart
Dim MyCharts As Excel.ChartObjects
Dim MyCharts1 As Excel.ChartObject
MyCharts = osheet.ChartObjects
REM mensetting lokasi chart
MyCharts1 = MyCharts.Add(150, 100, 400, 250)
oChart = MyCharts1.Chart
REM membuat chart pada default location
oChart.Location(Excel.XlChartLocation.xlLocationAsObject, osheet.Name)
With oChart
REM mengeset range untuk chart
Dim chartRange As Excel.Range
chartRange = osheet.Range("A3", Alphabets & R)
.SetSourceData(chartRange)
REM fungsi ini untuk mengeset bentuk dari plot, apakh kolom atau baris
.PlotBy = Excel.XlRowCol.xlRows
REM mensetting data label
.ApplyDataLabels(Excel.XlDataLabelsType.xlDataLabelsShowNone)
REM mensetting apakah legend tampil atau tidak
.HasLegend = True
REM mensetting lokasi legend
.Legend.Position = Excel.XlLegendPosition.xlLegendPositionRight
REM Pilih tipe chart
.ChartType = Excel.XlChartType.xlColumnClustered
REM chart title
.HasTitle = True
.ChartTitle.Text = " Daftar Nilai Bar Chart"
Dim xlAxisCategory, xlAxisValue As Excel.Axes
xlAxisCategory = CType(oChart.Axes(, Excel.XlAxisGroup.xlPrimary), Excel.Axes)
xlAxisCategory.Item(Excel.XlAxisType.xlCategory).HasTitle = True
xlAxisCategory.Item(Excel.XlAxisType.xlCategory).AxisTitle.Characters.Text = "Term Tes"
xlAxisValue = CType(oChart.Axes(, Excel.XlAxisGroup.xlPrimary), Excel.Axes)
xlAxisValue.Item(Excel.XlAxisType.xlValue).HasTitle = True
xlAxisValue.Item(Excel.XlAxisType.xlValue).AxisTitle.Characters.Text = "Distribusi Skala Nilai"
End With
End Sub
Sub View_Data()
objDataTable.Clear()
strSQL = "select * from [Daftar Nilai]"
objCommand = New OleDbCommand
objCommand.Connection = MyConnection.open
objCommand.CommandType = CommandType.Text
objCommand.CommandText = strSQL
objDataAdapter = New OleDbDataAdapter(objCommand)
objDataAdapter.Fill(objDataSet, "Mdt_Daftar Nilai")
MyConnection.close()
objDataTable = objDataSet.Tables("Mdt_Daftar Nilai")
DataGridView1.DataSource = objDataTable
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Try
REM Nama File dan path. file akan disimpan di mana file exe brada
Filename = Application.StartupPath & "\Data.xlsx"
REM cek apakah file exist jika iya kemudian delete untuk membuat file baru.
If File.Exists(Filename) Then
File.Delete(Filename)
End If
If Not File.Exists(Filename) Then
chkexcel = False
REM Membuat excel aplikasi yang baru
oexcel = CreateObject("Excel.Application")
REM tambahkan worbook yang baru
obook = oexcel.Workbooks.Add
REM mensetting application alert
oexcel.Application.DisplayAlerts = True
REM mengecek total sheet pada workbook
Dim S As Integer = oexcel.Application.Sheets.Count()
REM delete seluruh sheet kecuali sheet pertama
If S > 1 Then
oexcel.Application.DisplayAlerts = False
Dim J As Integer = S
Do While J > 1
oexcel.Application.Sheets(J).delete()
J = oexcel.Application.Sheets.Count()
Loop
End If
REM untuk mengecek session dari excel application
chkexcel = True
oexcel.Visible = True
REM procedure untuk mengisi data pada excel file
Generate_Sheet()
REM meyimpan excel file
obook.SaveAs(Filename)
REM menutup excel object dan session
osheet = Nothing
oexcel.Application.DisplayAlerts = False
obook.Close()
oexcel.Application.DisplayAlerts = True
obook = Nothing
oexcel.Quit()
oexcel = Nothing
chkexcel = False
MsgBox("Export Diselesaikan Dengan baik")
End If
Catch ex As Exception
MsgBox(ex.Message)
Finally
MyConnection.close()
Dbclose()
End Try
End Sub
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Try
View_Data()
Catch ex As Exception
MsgBox(ex.Message)
Finally
MyConnection.close()
End Try
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
End
End Sub
End Class
Setelah mengetikkan listing dari source program diatas tekan F5, maka tampilan visualnya seperti gambar di atas.
Artikel yang berkaitan dengan Tutorial ini Klik ==> di sini & Tutorial Link Access 2000, 2003 dan 2007 ==> di siniSelamat mencoba Guys! Nantikan Tips Aplikasi Cantik Lainnya by Verynandus Hutabalian
1. 
0 komentar:
Posting Komentar