Membuat Sampel Otomatis

Membuat Sampel Otomatis

1. Mulai Visual Basic dan buat projek Standard EXE yang baru. Form1 dibuat secara default.
2. KlikProjek kemudian klik Referensi. Kotak dialog Referensi muncul. Gulir daftar ke bawah hingga Anda menemukan perpustakaan objek Microsoft Excel, kemudian pilih item untuk menambahkan referensi pada Excel. Apabila perpustakaan objek yang benar untuk versi Excel Anda tidak muncul dalam daftar, pastikan versi Excel Anda terinstal dengan benar.
   
   
   Catatan
   • Apabila Anda sedang mengotomatisasi Microsoft Office Excel 2007, perpustakaan jenis muncul sebagai Perpustakaan Objek Microsoft Excel 12.0 dalam daftar Referensi.
   • Apabila Anda sedang mengotomatisasi Microsoft Office Excel 2003, perpustakaan jenis muncul sebagai Perpustakaan Objek Microsoft Excel 11.0 dalam daftar Referensi.
   • Apabila Anda sedang mengotomatisasi Microsoft Excel 2002, perpustakaan jenis muncul sebagai Perpustakaan Objek Microsoft Excel 10.0 dalam daftar Referensi
   • Apabila Anda sedang mengotomatisasi Microsoft Excel 2000, perpustakaan jenis muncul sebagai Perpustakaan Objek Microsoft Excel 9.0 dalam daftar Referensi.
   • Apabila Anda sedang mengotomatisasi Microsoft Excel 97, perpustakaan jenis muncul sebagai Perpustakaan Objek Microsoft Excel 8.0 dalam daftar Referensi
3. Klik OK untuk menutup kotak dialog Referensi.
4. Tambah CommandButton pada Form1.
5. Dalam jendela kode untuk Form1, masukkan kode berikut:

   
      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
   

6. Tekan F5 untuk menjalankan projek.

thank you for visitor , may be useful to you all

Tweet

Subscribe to receive free email updates: