Modul_3_V_B_Lanjutan

Rancangan Formulir



Source Code



Option Explicit
Public appexcel As Excel.Application
Public wbexcel As Excel.Workbook

Sub Setup()
On Error Resume Next
Set appexcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set appexcel = CreateObject("Excel.Application")
End If
Err.Clear
On Error GoTo 0
Set wbexcel = appexcel.Workbooks.Open(App.Path & "\data2.xls")
End Sub

Sub Bersih()
Set appexcel = Nothing
Set wbexcel = Nothing
End Sub
Sub IsiWSheet()
Dim shtMahasiswa As Excel.Worksheet
For Each shtMahasiswa In wbexcel.Sheets
FBukaExcel.cmbSheet.AddItem shtMahasiswa.Name
Next
FBukaExcel.cmbSheet.Text = FBukaExcel.cmbSheet.List(0)
Set shtMahasiswa = Nothing
End Sub


Sub TAmpilpitur()
Dim shtexcel As Excel.Worksheet
Dim Rangefitur As Excel.Range
Dim kolompertama As Integer
Dim loop1 As Integer

FBukaExcel.LstExcel.Visible = True

Set shtexcel = wbexcel.Sheets(FBukaExcel.cmbSheet.Text)
Set Rangefitur = shtexcel.Rows(1)

If (Rangefitur.Cells(1, 1) = "") Then
kolompertama = 0
Else
kolompertama = Rangefitur.Find("").Column
End If

FBukaExcel.cmbKolom.Clear

For loop1 = 1 To kolompertama
FBukaExcel.cmbKolom.AddItem Rangefitur.Cells(1, loop1)
Next

FBukaExcel.cmbKolom.Text = FBukaExcel.cmbKolom.List(0)

Set shtexcel = Nothing
Set Rangefitur = Nothing
End Sub

Sub Listmaster()
Dim shtexcel As Excel.Worksheet
Dim Integerkolom As Integer
Dim rangeexcel As Excel.Range
Dim kolompertama As Integer
Dim loop1 As Integer

Set shtexcel = wbexcel.Sheets(FBukaExcel.cmbSheet.Text)
FBukaExcel.LstExcel.Clear
If (FBukaExcel.cmbKolom <> "") Then
Integerkolom = shtexcel.Rows(1).Find(FBukaExcel.cmbKolom.Text).Column
Set rangeexcel = shtexcel.Columns(Integerkolom)
If (rangeexcel.Cells(1, 1) = "") Then
kolompertama = 0
Else
kolompertama = rangeexcel.Find("").Row
End If
For loop1 = 2 To kolompertama
FBukaExcel.LstExcel.AddItem rangeexcel.Cells(loop1, 1)
Next
FBukaExcel.LstExcel.Visible = True

End If

Set shtexcel = Nothing
Set rangeexcel = Nothing
End Sub


Private Sub CMDKELUAR_Click()
End
End Sub

Sub Form_Load()
Setup
IsiWSheet
End Sub

Sub Form_Unload(Cancel As Integer)
Bersih
End Sub

Private Sub cmbSheet_Change()
FillFeaturesList
End Sub

Private Sub cmbKolom_Change()
Listmaster
End Sub

Sub cmbkolom_Click()
Listmaster
End Sub

Sub cmbsheet_Click()
TAmpilpitur
End Sub


.: STMIK Kharisma Karawang :.