[go: up one dir, main page]
Scribd
Upload
14 views9 pages

Coding Form Utama

This document contains a comprehensive Excel VBA tutorial with various subroutines for managing a restaurant ordering system. It includes functionalities for adding and deleting orders, calculating totals, filtering food and drink types, and managing tables. Error handling is implemented throughout to ensure user-friendly interactions.

Uploaded by

samashin55
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
14 views9 pages

Coding Form Utama

This document contains a comprehensive Excel VBA tutorial with various subroutines for managing a restaurant ordering system. It includes functionalities for adding and deleting orders, calculating totals, filtering food and drink types, and managing tables. Error handling is implemented throughout to ensure user-friendly interactions.

Uploaded by

samashin55
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
You are on page 1/ 9

-------------------------------------------------

CODING FORM UTAMA: EXCEL VBA TUTORIAL


-------------------------------------------------

Option Explicit

Private Sub ADD_Click()


On Error GoTo EXCELVBA
Dim CARIPESANAN As Object

Set CARIPESANAN = ActiveSheet.Range("A2:A1000").Find(What:=Me.TXTNOMOR1.Value,


LookIn:=xlValues)
Me.TXTQTY.Value = Val(TXTQTY.Value) + 1
CARIPESANAN.Offset(0, 2).Value = Me.TXTQTY.Value
CARIPESANAN.Offset(0, 4).Value = Val(Me.TXTQTY.Value) *
Val(Me.TABELPESANAN.Column(3))

Call HitungTotal
Me.DEL.Enabled = True
Exit Sub
EXCELVBA:
Call MsgBox("Pilih terlebih dahulu data pesanan", vbInformation, "Pilih Pesanan")
End Sub

Private Sub CMBJENIS_Change()


On Error GoTo Salah
If Me.OPTMAKANAN.Value = True Then
Dim CariMakanan As Object
Set CariMakanan = Sheet1
CariMakanan.Range("H6").Value = Me.CMBJENIS.Value
CariMakanan.Range("A5").CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
CriteriaRange:= _
Sheet1.Range("H5:H6"), Copytorange:=Sheet1.Range("J5:O5"), Unique:=False
Call HASILCARIMAKANAN
End If

If Me.OPTMINUMAN.Value = True Then


Dim CariMinuman As Object
Set CariMinuman = Sheet2
CariMinuman.Range("H6").Value = Me.CMBJENIS.Value
CariMinuman.Range("A5").CurrentRegion.AdvancedFilter Action:=xlFilterCopy,
CriteriaRange:= _
Sheet2.Range("H5:H6"), Copytorange:=Sheet2.Range("J5:O5"), Unique:=False
Call HASILCARIMINUMAN
End If

Exit Sub
Salah:
Call MsgBox("Data tidak ditemukan", vbInformation, "Cari Data")

End Sub
Private Sub HASILCARIMAKANAN()
Dim DBMAKANAN As Long
Dim irow As Long
irow = Sheet1.Range("J" & Rows.Count).End(xlUp).Row
DBMAKANAN = Application.WorksheetFunction.CountA(Sheet1.Range("J6:J1000000"))
If DBMAKANAN = 0 Then
FORMUTAMA.TABELMENU.RowSource = ""
Else
FORMUTAMA.TABELMENU.RowSource = "MAKANAN!J6:O" & irow
End If
End Sub
Private Sub HASILCARIMINUMAN()
Dim DBMAKANAN As Long
Dim irow As Long
irow = Sheet2.Range("J" & Rows.Count).End(xlUp).Row
DBMAKANAN = Application.WorksheetFunction.CountA(Sheet2.Range("J6:J1000000"))
If DBMAKANAN = 0 Then
FORMUTAMA.TABELMENU.RowSource = ""
Else
FORMUTAMA.TABELMENU.RowSource = "MINUMAN!J6:O" & irow
End If
End Sub

Private Sub CMDADDMEJA_Click()


Dim DATAMEJA As Object
Set DATAMEJA = Sheet4.Range("A1000").End(xlUp)
If Me.TXTMEJA.Value = "" Then
Call MsgBox("Harap isi terlebih dahulu Nama Meja", vbInformation, "Nama Meja")
Else
Sheets.ADD(After:=Sheets("STRUK")).Name = Me.TXTMEJA.Value
DATAMEJA.Offset(1, 0).Value = Me.TXTMEJA.Value
DATAMEJA.Offset(1, 1).Value = "Ready"
Me.TXTMEJA.Value = ""
Sheet3.Range("I4:M4").Copy Destination:=ActiveSheet.Range("A1")
Call AmbilMeja
End If
End Sub
Private Sub HitungTotal()
Dim MySum As Double
Dim r As Long
MySum = 0
With TABELPESANAN
For r = 0 To .ListCount - 1
MySum = MySum + .List(r, 4)
Next r
End With

Me.TXTTOTAL.Value = Format(MySum, "#,###")

End Sub

Private Sub CMDATUR_Click()


FORMFOLDER.Show
End Sub

Private Sub CMDBAYAR_Click()


On Error GoTo EXCELVBA
Dim PilihSheet As String
PilihSheet = Me.TXTPESANMEJA.Value
Worksheets(PilihSheet).Activate

If Me.TXTPESANMEJA.Value = "" Then


Call MsgBox("Harap pilih meja terlebih dahulu", vbInformation, "Pilih Meja")
Else
Sheet6.Range("B8").Value = Me.TXTPESANMEJA.Value

FORMBAYAR.TXTMEJA.Value = Me.TXTPESANMEJA.Value
FORMBAYAR.Show
End If
Exit Sub
EXCELVBA:
Call MsgBox("Harap pilih Meja terlebih dahulu", vbInformation, "Pilih Meja")

End Sub

Private Sub CMDBELI_Click()


On Error GoTo EXCELVBA
Dim PilihSheet As String
Dim DBPESAN As Object
Dim STATUSMEJA As Object
PilihSheet = Me.TXTPESANMEJA.Value
Worksheets(PilihSheet).Activate

Set DBPESAN = ActiveSheet.Range("A10000").End(xlUp)


DBPESAN.Offset(1, 0).Value = "=ROW()-ROW($A$1)"
DBPESAN.Offset(1, 1).Value = Me.TXTNAMA.Value
DBPESAN.Offset(1, 2).Value = 1
DBPESAN.Offset(1, 3).Value = Me.TXTHARGA.Value
DBPESAN.Offset(1, 4).Value = Val(Me.TXTHARGA.Value) * DBPESAN.Offset(1, 2).Value

Set STATUSMEJA = Sheet4.Range("A5:A1000").Find(What:=Me.TXTPESANMEJA.Value,


LookIn:=xlValues)
STATUSMEJA.Offset(0, 1).Value = "On"

Call AmbilPesanan
Call HitungTotal
Me.CMDBELI.Enabled = False
Exit Sub
EXCELVBA:
Call MsgBox("Harap pilih menu terlebih dahulu", vbInformation, "Pilih Menu")

End Sub

Private Sub CMDDELETE_Click()


If Me.TXTNOMOR.Value = "" Then
Call MsgBox("Pilih data pada tabel data", vbInformation, "Hapus Data")
Else
Select Case MsgBox("Anda akan menghapus data" _
& vbCrLf & "Apakah anda yakin?" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Hapus data")
Case vbNo
Exit Sub
Case vbYes
End Select
Me.TABELMENU.RowSource = ""
Me.TXTNOMOR.Value = ""
Sheet1.Select
Selection.EntireRow.DELETE
Sheet1.Select
End If
End Sub

Private Sub CMDDELETEMEJA_Click()


Dim SUMBERDATA, CELLAKTIF As Long
Me.TXTHAPUSMEJA.Value = Me.LISTTABEL.Value
If Me.TXTHAPUSMEJA.Value = "" Then
Call MsgBox("Harap pilih desa yang akan dihapus", vbInformation, "Pilih Meja")
Else
Select Case MsgBox("Anda akan menghapus Sheet" _
& vbCrLf & "Apakah anda yakin?" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Hapus Meja")
Case vbNo
Exit Sub
Case vbYes
End Select

Application.DisplayAlerts = False
ActiveSheet.DELETE
Application.DisplayAlerts = False

Me.LISTTABEL.Value = ""
Sheet4.Select
SUMBERDATA = Sheets("MEJA").Cells(Rows.Count, "A").End(xlUp).Row
Sheet4.Range("A5:A" & SUMBERDATA).Find(What:=Me.TXTHAPUSMEJA.Value,
LookIn:=xlValues, LookAt:=xlWhole).Activate
CELLAKTIF = ActiveCell.Row

Selection.EntireRow.DELETE

Me.TXTHAPUSMEJA.Value = ""
Call AmbilMeja

End If
End Sub

Private Sub CMDKELUAR_Click()


Select Case MsgBox("Anda akan keluar dari Aplikasi" _
& vbCrLf & "Apakah anda yakin?" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Keluar")
Case vbNo
Exit Sub
Case vbYes
End Select
Unload Me
Application.Visible = True
ThisWorkbook.Save
ThisWorkbook.Close
End Sub

Private Sub CMDLAPORAN_Click()


FORMLAPORAN.Show
End Sub

Private Sub CMDMAKANAN_Click()


Me.TXTNOMOR.Value = ""
Me.TABELMENU.Value = ""
FORMMAKANAN.Show
End Sub
Private Sub AmbilMeja()
Dim DBMEJA As Long
Dim irow As Long
irow = Sheet4.Range("A" & Rows.Count).End(xlUp).Row
DBMEJA = Application.WorksheetFunction.CountA(Sheet4.Range("A5:A100"))
If DBMEJA = 0 Then
FORMUTAMA.LISTTABEL.RowSource = ""
Else
FORMUTAMA.LISTTABEL.RowSource = "MEJA!A5:B" & irow
End If
End Sub

Private Sub AmbilJenisMakanan()


Dim DBJENISMAKANAN As Long
Dim irow As Long
irow = Sheet3.Range("A" & Rows.Count).End(xlUp).Row
DBJENISMAKANAN = Application.WorksheetFunction.CountA(Sheet3.Range("B6:B100"))
If DBJENISMAKANAN = 0 Then
FORMUTAMA.CMBJENIS.RowSource = ""
Else
FORMUTAMA.CMBJENIS.RowSource = "JENIS!B5:B" & 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("E6:E100"))
If DBJENISMINUMAN = 0 Then
FORMUTAMA.CMBJENIS.RowSource = ""
Else
FORMUTAMA.CMBJENIS.RowSource = "JENIS!E5:E" & irow
End If
End Sub
Private Sub AmbilPesanan()
Dim DBPESANAN As Long
Dim irow As Long
With ActiveSheet
irow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
DBPESANAN = Application.WorksheetFunction.CountA(ActiveSheet.Range("A2:A1000"))
If DBPESANAN = 0 Then
FORMUTAMA.TABELPESANAN.RowSource = ""
Else
FORMUTAMA.TABELPESANAN.RowSource = "A2:E" & irow
End If
End With
End Sub
Private Sub CMDMINUMAN_Click()
Me.TXTNOMOR.Value = ""
Me.TABELMENU.Value = ""
FORMMINUMAN.Show
End Sub

Private Sub CMDRESET_Click()


Me.CMBJENIS.Value = ""
Me.OPTMAKANAN.Value = True
End Sub

Private Sub CMDSIMPAN_Click()


ThisWorkbook.Save

End Sub

Private Sub CMDUPDATE_Click()


On Error GoTo EXCELVBA
If Me.OPTMAKANAN.Value = True Then
With FORMMAKANAN
.TXTMAKANAN.Value = Me.TABELMENU.Column(1)
.CMBJENIS.Value = Me.TABELMENU.Column(2)
.TXTDESKRIPSI.Value = Me.TABELMENU.Column(3)
.TXTHARGA.Value = Me.TABELMENU.Column(4)
.TXTFOTO.Value = Me.TABELMENU.Column(5)
On Error Resume Next
.Image1.Picture = LoadPicture(Me.TABELMENU.Column(5))
.Image1.PictureSizeMode = 1
.CMDADD.Enabled = False
End With
FORMMAKANAN.Show
End If
If Me.OPTMINUMAN.Value = True Then
With FORMMINUMAN
.TXTMINUMAN.Value = Me.TABELMENU.Column(1)
.CMBJENIS.Value = Me.TABELMENU.Column(2)
.TXTDESKRIPSI.Value = Me.TABELMENU.Column(3)
.TXTHARGA.Value = Me.TABELMENU.Column(4)
.TXTFOTO.Value = Me.TABELMENU.Column(5)
On Error Resume Next
.Image1.Picture = LoadPicture(Me.TABELMENU.Column(5))
.Image1.PictureSizeMode = 1
.CMDADD.Enabled = False
End With
FORMMINUMAN.Show
End If
Exit Sub

EXCELVBA:
Call MsgBox("Silahkan pilih kembali data yang akan diubah", vbInformation, "Ubah
data")

End Sub

Private Sub CommandButton7_Click()

End Sub

Private Sub DEL_Click()


On Error GoTo EXCELVBA
Dim CARIPESANAN As Object
Set CARIPESANAN = ActiveSheet.Range("A2:A1000").Find(What:=Me.TXTNOMOR1.Value,
LookIn:=xlValues)
Me.TXTQTY.Value = Val(TXTQTY.Value) - 1
CARIPESANAN.Offset(0, 2).Value = Me.TXTQTY.Value
CARIPESANAN.Offset(0, 4).Value = Val(Me.TXTQTY.Value) *
Val(Me.TABELPESANAN.Column(3))

Call HitungTotal
If Me.TXTQTY.Value = 1 Then
Me.DEL.Enabled = False
Else
Me.DEL.Enabled = True
End If
Exit Sub
EXCELVBA:
Call MsgBox("Pilih terlebih dahulu data pesanan", vbInformation, "Pilih Pesanan")

End Sub

Private Sub DELETE_Click()


If Me.TXTNOMOR1.Value = "" Then
Call MsgBox("Pilih data pada tabel data", vbInformation, "Hapus Data")
Else
Select Case MsgBox("Anda akan menghapus data" _
& vbCrLf & "Apakah anda yakin?" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Hapus data")
Case vbNo
Exit Sub
Case vbYes
End Select

Selection.EntireRow.DELETE
Me.TABELPESANAN.RowSource = ""
Me.TXTNOMOR1.Value = ""
Me.TXTQTY.Value = ""
Call AmbilPesanan
Call HitungTotal
End If

End Sub

Private Sub LISTTABEL_Click()


Dim PilihSheet As String
PilihSheet = Me.LISTTABEL.Value
Worksheets(PilihSheet).Activate
Me.TXTHAPUSMEJA.Value = Me.LISTTABEL.Value
Call AmbilMeja
Call AmbilPesanan
Call HitungTotal
Me.TXTPESANMEJA.Value = Me.LISTTABEL.Value
Me.TABELMENU.Value = ""
Me.TXTNOMOR.Value = ""
Me.TXTNAMA.Value = ""
Me.TXTJENIS.Value = ""
Me.TXTDESKRIPSI.Value = ""
Me.TXTHARGA.Value = ""
Me.Image1.Picture = Nothing
Me.TXTWAKTU.Value = Now
Me.OPTMAKANAN.Enabled = True
Me.OPTMINUMAN.Enabled = True
End Sub

Private Sub OPTMAKANAN_Click()


Dim DBJENISMAKANAN As Long
Dim irow As Long
If Me.OPTMAKANAN.Value = True Then
irow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
DBJENISMAKANAN = Application.WorksheetFunction.CountA(Sheet1.Range("A6:A100"))
If DBJENISMAKANAN = 0 Then
FORMUTAMA.TABELMENU.RowSource = ""
Else
FORMUTAMA.TABELMENU.RowSource = "MAKANAN!A6:F" & irow
End If
End If
Call AmbilJenisMakanan

End Sub

Private Sub OPTMINUMAN_Click()


Dim DBJENISMINUMAN As Long
Dim irow As Long
If Me.OPTMINUMAN.Value = True Then
irow = Sheet2.Range("A" & Rows.Count).End(xlUp).Row
DBJENISMINUMAN = Application.WorksheetFunction.CountA(Sheet2.Range("A6:A100"))
If DBJENISMINUMAN = 0 Then
FORMUTAMA.TABELMENU.RowSource = ""
Else
FORMUTAMA.TABELMENU.RowSource = "MINUMAN!A6:F" & irow
End If
End If
Call AmbilJenisMinuman

End Sub

Private Sub TABELMENU_Click()


On Error GoTo EXCELVBA
Dim SUMBERDATA, CELLAKTIF As Long
Me.TXTNOMOR.Value = Me.TABELMENU.Value
Me.TXTNAMA.Value = Me.TABELMENU.Column(1)
Me.TXTJENIS.Value = Me.TABELMENU.Column(2)
Me.TXTDESKRIPSI.Value = Me.TABELMENU.Column(3)
Me.TXTHARGA.Value = Me.TABELMENU.Column(4)
On Error Resume Next
Me.Image1.Picture = LoadPicture(Me.TABELMENU.Column(5))
Me.Image1.PictureSizeMode = 1
Sheet1.Select
SUMBERDATA = Sheets("MAKANAN").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("MAKANAN").Range("A6:A" & SUMBERDATA).Find(What:=Me.TXTNOMOR.Value,
LookIn:=xlValues, LookAt:=xlWhole).Activate
CELLAKTIF = ActiveCell.Row
Sheet1.Select
Me.CMDBELI.Enabled = True
Me.LISTTABEL.Value = ""
Exit Sub
EXCELVBA:
Call MsgBox("Pilih menu pada tabel menu", vbInformation, "Pilih Menu")
End Sub
Private Sub TABELPESANAN_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo EXCELVBA
Dim SUMBERDATA, CELLAKTIF As Long
Dim PilihSheet As String
PilihSheet = Me.TXTPESANMEJA.Value
Worksheets(PilihSheet).Activate

Me.TXTNOMOR1.Value = Me.TABELPESANAN.Value
Me.TXTQTY.Value = Me.TABELPESANAN.Column(2)
With ActiveSheet
SUMBERDATA = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
ActiveSheet.Range("A2:A" & SUMBERDATA).Find(What:=Me.TXTNOMOR1.Value,
LookIn:=xlValues, LookAt:=xlWhole).Activate
CELLAKTIF = ActiveCell.Row
End With
If Me.TXTQTY.Value = 1 Then
Me.DEL.Enabled = False
Else
Me.DEL.Enabled = True
End If
Me.ADD.Enabled = True

Exit Sub
EXCELVBA:
Call MsgBox("Pilih data pesanan", vbInformation, "Pilih Pesanan")
End Sub

Private Sub TXTMEJA_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)


If KeyAscii = 32 Then
KeyAscii = 0
End If
End Sub

Private Sub UserForm_Initialize()


Call AmbilMeja
Me.ADD.Enabled = False
Me.DEL.Enabled = False
Me.OPTMAKANAN.Enabled = False
Me.OPTMINUMAN.Enabled = False
Me.TXTFOLDER.Value = Sheet3.Range("G4").Value
Me.Frame3.BackColor = RGB(60, 61, 68)
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)


If CloseMode = 0 Then
Cancel = True
End If

End Sub

You might also like