-------------------------------------------------
CODING FORM MINUMAN: EXCEL VBA TUTORIAL
-------------------------------------------------
Option Explicit
Dim ERWING As String
Private Sub CMDADD_Click()
Dim GambarMinuman As String
GambarMinuman = Me.TXTMINUMAN.Value
Dim DBMINUMAN As Object
'Perintah menentukan tempat simpan data
Set DBMINUMAN = Sheet2.Range("A800").End(xlUp)
'Perintah menentukan data yang wajib diisi
If Me.TXTMINUMAN.Value = "" _
Or Me.CMBJENIS.Value = "" _
Or Me.TXTDESKRIPSI.Value = "" _
Or Me.TXTHARGA.Value = "" Then
'Perintah membuat pesan jika data kosong
Call MsgBox("Harap isi data makanan", vbInformation, "Data Makanan")
'Perintah menyimpan data jika data diisi lengkap
Else
On Error GoTo EXCELVBA
FileCopy ERWING, Sheet3.Range("G4").Value & GambarMinuman & ".jpg"
DBMINUMAN.Offset(1, 0).Value = "=ROW()-ROW($A$5)"
DBMINUMAN.Offset(1, 1).Value = Me.TXTMINUMAN.Value
DBMINUMAN.Offset(1, 2).Value = Me.CMBJENIS.Value
DBMINUMAN.Offset(1, 3).Value = Me.TXTDESKRIPSI.Value
DBMINUMAN.Offset(1, 4).Value = Me.TXTHARGA.Value
DBMINUMAN.Offset(1, 5).Value = Me.TXTFOTO.Value
Call MsgBox("Menu minuman berhasil ditambah", vbInformation, "Data Minuman")
Call AmbilMinuman
'Perintah membersihkan Form setelah data berhasil disimpan
Me.TXTMINUMAN.Value = ""
Me.CMBJENIS.Value = ""
Me.TXTDESKRIPSI.Value = ""
Me.TXTHARGA.Value = ""
Me.TXTFOTO.Value = ""
Me.Image1.Picture = Nothing
End If
Exit Sub
EXCELVBA:
Call MsgBox("Harap upload file gambar menu dengan jenis file JPG", vbInformation,
"Format Salah")
End Sub
Private Sub AmbilMinuman()
Dim DBMINUMAN As Long
Dim irow As Long
irow = Sheet2.Range("A" & Rows.Count).End(xlUp).Row
DBMINUMAN = Application.WorksheetFunction.CountA(Sheet2.Range("A6:A100"))
If DBMINUMAN = 0 Then
FORMUTAMA.TABELMENU.RowSource = ""
Else
FORMUTAMA.TABELMENU.RowSource = "MINUMAN!A6:E" & irow
End If
End Sub
Private Sub AmbilJenisMinuman()
Dim DBJENISMINUMAN As Long
Dim irow As Long
irow = Sheet3.Range("D" & Rows.Count).End(xlUp).Row
DBJENISMINUMAN = Application.WorksheetFunction.CountA(Sheet3.Range("E5:E100"))
If DBJENISMINUMAN = 0 Then
Me.CMBJENIS.RowSource = ""
Else
Me.CMBJENIS.RowSource = "JENIS!E5:E" & irow
End If
End Sub
Private Sub CMDUPDATE_Click()
'Perintah membuat sumber data ubah
Dim GambarMenu As String
GambarMenu = Me.TXTMINUMAN.Value
Dim SUMBERUBAH As Object
Set SUMBERUBAH = Sheet2.Range("A6:A100000").Find(What:=FORMUTAMA.TXTNOMOR.Value,
LookIn:=xlValues)
'perintah memastikan bahwa data yang akan diupdate telah dipilih
If Me.TXTMINUMAN.Value = "" Then
Call MsgBox("Data yang diupdate belum dipilih", vbInformation, "Update Data")
Else
On Error Resume Next
FileCopy ERWING, Sheet3.Range("G4").Value & GambarMenu & ".jpg"
SUMBERUBAH.Offset(0, 1).Value = Me.TXTMINUMAN.Value
SUMBERUBAH.Offset(0, 2).Value = Me.CMBJENIS.Value
SUMBERUBAH.Offset(0, 3).Value = Me.TXTDESKRIPSI.Value
SUMBERUBAH.Offset(0, 4).Value = Me.TXTHARGA.Value
SUMBERUBAH.Offset(0, 5).Value = Me.TXTFOTO.Value
Call MsgBox("Data berhasil diupdate", vbInformation, "Update Data")
Unload Me
End If
End Sub
Private Sub CMDUPLOAD_Click()
On Error GoTo Salah
Dim Erwin As Integer
If Me.TXTMINUMAN.Value = "" Then
Call MsgBox("Harap isi terlebih dahulu Nama User", vbInformation, "Nama User")
Else
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
Erwin = Application.FileDialog(msoFileDialogOpen).Show
If Erwin <> 0 Then
ERWING = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
Me.Image1.Picture = LoadPicture(ERWING)
Me.Image1.PictureSizeMode = 1
Me.TXTFOTO.Value = Sheet3.Range("G4").Value & Me.TXTMINUMAN.Value & ".jpg"
End If
End If
Exit Sub
Salah:
Call MsgBox("Pastikan telah membuat Folder Baru dengan Nama DATABASE pada Drive C",
vbInformation, "Folder Database")
End Sub
Private Sub UserForm_Initialize()
Call AmbilJenisMinuman
End Sub