Option Explicit
Private Sub Command1_Click()
Dim oXL As Excel.Application
Dim oWB As Excel.Workbook
Dim oSheet As Excel.Worksheet
Dim oRng As Excel.Range
'Pada Galat GoTo Err_Handler
' Mulai Excel dan dapatkan objek Aplikasi.
Set oXL = CreateObject("Excel.Application")
oXL.Visible = True
' Dapatkan buku kerja yang baru.
Set oWB = oXL.Workbooks.Add
Set oSheet = oWB.ActiveSheet
' Tambah header tabel dengan cara sel per sel.
oSheet.Cells(1, 1).Value = "First Name"
oSheet.Cells(1, 2).Value = "Last Name"
oSheet.Cells(1, 3).Value = "Full Name"
oSheet.Cells(1, 4).Value = "Salary"
' Format A1:D1 sebagai tebal, lurus vertikal = tengah.
With oSheet.Range("A1", "D1")
.Font.Bold = True
.VerticalAlignment = xlVAlignCenter
End With
' Buat larik untuk mengatur banyak nilai secara bersamaan.
Dim saNames(5, 2) As String
saNames(0, 0) = "John"
saNames(0, 1) = "Smith"
saNames(1, 0) = "Tom"
saNames(1, 1) = "Brown"
saNames(2, 0) = "Sue"
saNames(2, 1) = "Thomas"
saNames(3, 0) = "Jane"
saNames(3, 1) = "Jones"
saNames(4, 0) = "Adam"
saNames(4, 1) = "Johnson"
' Isi A2:B6 dengan satu larik nilai (Nama Depan dan Belakang).
oSheet.Range("A2", "B6").Value = saNames
' Isi C2:C6 dengan formula relatif (=A2 & " " & B2).
Set oRng = oSheet.Range("C2", "C6")
oRng.Formula = "=A2 & "" "" & B2"
' Isi D2:D6 dengan formula(=RAND()*100000) dan gunakan format.
Set oRng = oSheet.Range("D2", "D6")
oRng.Formula = "=RAND()*100000"
oRng.NumberFormat = "$0.00"
' Kolom AutoFit A:D.
Set oRng = oSheet.Range("A1", "D1")
oRng.EntireColumn.AutoFit
' Manipulasi jumlah variabel kolom untuk Data Penjualan Tigabulanan.
Call DisplayQuarterlySales(oSheet)
' Pastikan Excel terlihat dan memberikan kontrol pengguna
' pada masa usia Microsoft Excel.
oXL.Visible = True
oXL.UserControl = True
' Pastikan Anda mengeluarkan referensi objek.
Set oRng = Nothing
Set oSheet = Nothing
Set oWB = Nothing
Set oXL = Nothing
Exit Sub
Err_Handler:
MsgBox Err.Description, vbCritical, "Error: " & Err.Number
End Sub
Private Sub DisplayQuarterlySales(oWS As Excel.Worksheet)
Dim oResizeRange As Excel.Range
Dim oChart As Excel.Chart
Dim iNumQtrs As Integer
Dim sMsg As String
Dim iRet As Integer
' Tentukan berapa banyak bagian untuk menampilkan data.
For iNumQtrs = 4 To 2 Step -1
sMsg = "Enter sales data for" & Str(iNumQtrs) & " quarter(s)?"
iRet = MsgBox(sMsg, vbYesNo Or vbQuestion _
Or vbMsgBoxSetForeground, "Quarterly Sales")
If iRet = vbYes Then Exit For
Next iNumQtrs
sMsg = "Displaying data for" & Str(iNumQtrs) & " quarter(s)."
MsgBox sMsg, vbMsgBoxSetForeground, "Quarterly Sales"
' Memulai pada E1, isi header untuk jumlah kolom yang dipilih.
Set oResizeRange = oWS.Range("E1", "E1").Resize(ColumnSize:=iNumQtrs)
oResizeRange.Formula = "=""Q"" & COLUMN()-4 & CHAR(10) & ""Sales"""
' Ubah Orientasi dan properti WrapText untuk header.
oResizeRange.Orientation = 38
oResizeRange.WrapText = True
' Isi warna interior dari header.
oResizeRange.Interior.ColorIndex = 36
' Isi kolom dengan formula dan gunakan format angka.
Set oResizeRange = oWS.Range("E2", "E6").Resize(ColumnSize:=iNumQtrs)
oResizeRange.Formula = "=RAND()*100"
oResizeRange.NumberFormat = "$0.00"
' Gunakan batas pada data Penjualan dan header.
Set oResizeRange = oWS.Range("E1", "E6").Resize(ColumnSize:=iNumQtrs)
oResizeRange.Borders.Weight = xlThin
' Tambah formula Total untuk data penjualan dan gunakan batas.
Set oResizeRange = oWS.Range("E8", "E8").Resize(ColumnSize:=iNumQtrs)
oResizeRange.Formula = "=SUM(E2:E6)"
With oResizeRange.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
End With
' Tambahkan Bagan untuk data yang dipilih
Set oResizeRange = oWS.Range("E2:E6").Resize(ColumnSize:=iNumQtrs)
Set oChart = oWS.Parent.Charts.Add
With oChart
.ChartWizard oResizeRange, xl3DColumn, , xlColumns
.SeriesCollection(1).XValues = oWS.Range("A2", "A6")
For iRet = 1 To iNumQtrs
.SeriesCollection(iRet).Name = "=""Q" & Str(iRet) & """"
Next iRet
.Location xlLocationAsObject, oWS.Name
End With
' Pindahkan bagan sehingga tidak menutupi data Anda.
With oWS.Shapes("Chart 1")
.Top = oWS.Rows(10).Top
.Left = oWS.Columns(2).Left
End With
' Kosongkan referensi.
Set oChart = Nothing
Set oResizeRange = Nothing
End Sub
Teknologi 
Kembali ke atas
