STEP 1.
MEMBUAT KODE UNTUK EXPORT GRAFIK MENJADI FILE JPG DAN MENAMPILKAN KE
USERFORM MELALUI MEDIA IMAGE YANG TELAH DIMASUKKAN
Dim GRAFIK1 As Chart
Dim GRAFIK2 As Chart
Dim GRAFIK3 As Chart
Dim GRAFIK4 As Chart
Dim Gambar1 As String
Dim Gambar2 As String
Dim Gambar3 As String
Dim Gambar4 As String
Private Sub BukaGrafik()
Set GRAFIK1 = Sheet4.ChartObjects("Chart 1").Chart
Set GRAFIK2 = Sheet4.ChartObjects("Chart 2").Chart
Set GRAFIK3 = Sheet4.ChartObjects("Chart 3").Chart
Set GRAFIK4 = Sheet4.ChartObjects("Chart 4").Chart
GRAFIK1.Parent.Width = 180
GRAFIK1.Parent.Height = 180
Grafik2.Parent.Width = 204
Grafik2.Parent.Height = 150
Grafik3.Parent.Width = 216
Grafik3.Parent.Height = 156
Grafik4.Parent.Width = 216
Grafik4.Parent.Height = 204
Gambar1 = ThisWorkbook.Path & "\" & "mychart1.JPEG"
Gambar2 = ThisWorkbook.Path & "\" & "mychart2.JPEG"
Gambar3 = ThisWorkbook.Path & "\" & "mychart3.JPEG"
Gambar4 = ThisWorkbook.Path & "\" & "mychart4.JPEG"
GRAFIK1.Export Filename:=Gambar1, Filtername:="JPEG"
Grafik2.Export Filename:=Gambar2, Filtername:="JPEG"
Grafik3.Export Filename:=Gambar3, Filtername:="JPEG"
Grafik4.Export Filename:=Gambar4, Filtername:="JPEG"
FOTO1.Picture = LoadPicture(Gambar1)
FOTO2.Picture = LoadPicture(Gambar2)
FOTO3.Picture = LoadPicture(Gambar3)
FOTO4.Picture = LoadPicture(Gambar4)
End Sub
STEP 2. MEMBUAT KODE UNTUK MEMUNCULKAN NILAI TOTAL PENJUALAN
Private Sub HitungData()
Me.QUANTITYTOTAL.Caption = Sheet4.Range("C8").Value
Me.PRICETOTAL.Caption = Sheet4.Range("D8").Value
Me.TOTALSALES.Caption = Sheet4.Range("E8").Value
Me.KELAS1.Caption = Sheet4.Range("e13").Value
Me.KELAS2.Caption = Sheet4.Range("e14").Value
Me.KELAS3.Caption = Sheet4.Range("e15").Value
End Sub
STEP 3. KODE UNTUK USERFORM INITIALIZE (MENGATUR WARNA DAN MENGISI TABEL DATA
DASHBOARD)
Private Sub UserForm_Initialize()
‘HideTitleBar Me
Me.PANELMENU.Height = Me.Height
Me.BackColor = RGB(230, 244, 244)
Me.PANELMENU.BackColor = RGB(14, 114, 60)
Me.PANEL1.BackColor = RGB(169, 210, 153)
Me.PANEL2.BackColor = RGB(255, 255, 255)
Me.PANEL3.BackColor = RGB(255, 255, 255)
Me.PANEL4.BackColor = RGB(255, 255, 255)
Me.PANEL5.BackColor = RGB(255, 255, 255)
Me.CARINAMA.BackColor = RGB(14, 114, 60)
Me.LOGOUT.BackColor = RGB(14, 114, 60)
Me.TABEL1.BackColor = RGB(169, 210, 153)
Me.TABEL1.RowSource = Sheet34.Range("TABELDATA1").Address(external:=True)
‘Me.PANELMENU.Enabled = False
Me.Image4.Visible = False
Me.TXT_NAMA.Visible = False
Me.CARINAMA.Visible = False
Me.LOGOUT.Visible = False
Call HitungData
Call BukaGrafik
End Sub
STEP 4. MEMBUAT EFFECT WARNA HIGHLIGHT PADA TOMBOL
Private Sub MENU1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single,
ByVal Y As Single)
Me.MENU1.BackStyle = fmBackStyleOpaque
Me.MENU1.BackColor = RGB(6, 54, 28)
Me.MENU2.BackStyle = fmBackStyleTransparent
Me.MENU2.BackColor = RGB(14, 114, 60)
Me.MENU3.BackStyle = fmBackStyleTransparent
Me.MENU3.BackColor = RGB(14, 114, 60)
Me.MENU4.BackStyle = fmBackStyleTransparent
Me.MENU4.BackColor = RGB(14, 114, 60)
Me.MENU5.BackStyle = fmBackStyleTransparent
Me.MENU5.BackColor = RGB(14, 114, 60)
End Sub
Private Sub MENU2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single,
ByVal Y As Single)
Me.MENU2.BackStyle = fmBackStyleOpaque
Me.MENU2.BackColor = RGB(6, 54, 28)
Me.MENU1.BackStyle = fmBackStyleTransparent
Me.MENU1.BackColor = RGB(14, 114, 60)
Me.MENU3.BackStyle = fmBackStyleTransparent
Me.MENU3.BackColor = RGB(14, 114, 60)
Me.MENU4.BackStyle = fmBackStyleTransparent
Me.MENU4.BackColor = RGB(14, 114, 60)
Me.MENU5.BackStyle = fmBackStyleTransparent
Me.MENU5.BackColor = RGB(14, 114, 60)
End Sub
Private Sub MENU3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single,
ByVal Y As Single)
Me.MENU3.BackStyle = fmBackStyleOpaque
Me.MENU3.BackColor = RGB(6, 54, 28)
Me.MENU1.BackStyle = fmBackStyleTransparent
Me.MENU1.BackColor = RGB(14, 114, 60)
Me.MENU2.BackStyle = fmBackStyleTransparent
Me.MENU2.BackColor = RGB(14, 114, 60)
Me.MENU4.BackStyle = fmBackStyleTransparent
Me.MENU4.BackColor = RGB(14, 114, 60)
Me.MENU5.BackStyle = fmBackStyleTransparent
Me.MENU5.BackColor = RGB(14, 114, 60)
End Sub
Private Sub MENU4_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single,
ByVal Y As Single)
Me.MENU4.BackStyle = fmBackStyleOpaque
Me.MENU4.BackColor = RGB(6, 54, 28)
Me.MENU1.BackStyle = fmBackStyleTransparent
Me.MENU1.BackColor = RGB(14, 114, 60)
Me.MENU2.BackStyle = fmBackStyleTransparent
Me.MENU2.BackColor = RGB(14, 114, 60)
Me.MENU3.BackStyle = fmBackStyleTransparent
Me.MENU3.BackColor = RGB(14, 114, 60)
Me.MENU5.BackStyle = fmBackStyleTransparent
Me.MENU5.BackColor = RGB(14, 114, 60)
End Sub
Private Sub MENU5_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single,
ByVal Y As Single)
Me.MENU5.BackStyle = fmBackStyleOpaque
Me.MENU5.BackColor = RGB(6, 54, 28)
Me.MENU2.BackStyle = fmBackStyleTransparent
Me.MENU2.BackColor = RGB(14, 114, 60)
Me.MENU3.BackStyle = fmBackStyleTransparent
Me.MENU3.BackColor = RGB(14, 114, 60)
Me.MENU4.BackStyle = fmBackStyleTransparent
Me.MENU4.BackColor = RGB(14, 114, 60)
Me.MENU1.BackStyle = fmBackStyleTransparent
Me.MENU1.BackColor = RGB(14, 114, 60)
End Sub
STEP 5. MENGEMBALIKAN KONDISI PANEL MENU UTAMA
Private Sub PANELMENU_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single,
ByVal Y As Single)
Me.MENU5.BackStyle = fmBackStyleTransparent
Me.MENU5.BackColor = RGB(14, 114, 60)
Me.MENU2.BackStyle = fmBackStyleTransparent
Me.MENU2.BackColor = RGB(14, 114, 60)
Me.MENU3.BackStyle = fmBackStyleTransparent
Me.MENU3.BackColor = RGB(14, 114, 60)
Me.MENU4.BackStyle = fmBackStyleTransparent
Me.MENU4.BackColor = RGB(14, 114, 60)
Me.MENU1.BackStyle = fmBackStyleTransparent
Me.MENU1.BackColor = RGB(14, 114, 60)
End Sub
STEP 6. LOG IN
‘CODE UNTUK TEXTBOX USERNAME
Private Sub USERNAME_Change()
On Error Resume Next
Set finduser = Sheet4.Range("A2:A100").Find(WHAT:=Me.USERNAME.Value, LookIn:=xlValues)
Me.PASSWORD2.Caption = finduser.Offset(0, 1).Value
End Sub
‘Code untuk Tombol Login
Private Sub MASUK_Click()
If Me.USERNAME.Value = "" _
Or Me.PASSWORD.Value = "" _
Or Me.PASSWORD2.Caption = "" _
Or Me.PASSWORD.Value <> Me.PASSWORD2.Caption Then
Call MsgBox("Username atau password yang dimasukkan salah", vbInformation, "Password Salah")
Else
Me.MultiPage1.Value = 1
Me.TXT_NAMA.Value = Sheet2.Range("A2").Value
Call PANGGILNAMA
Me.PANELMENU.Enabled = True
Me.Image4.Visible = True
Me.TXT_NAMA.Visible = True
Me.CARINAMA.Visible = True
Me.LOGOUT.Visible = True
Me.USERNAME.Value = ""
Me.PASSWORD.Value = ""
End If
End Sub
STEP 7. TOMBOL LOG OUT
Private Sub LOGOUT_Click()
Me.MultiPage1.Value = 0
Me.TXT_NAMA.Value = ""
Me.PANELMENU.Enabled = False
Me.Image4.Visible = False
Me.TXT_NAMA.Visible = False
Me.CARINAMA.Visible = False
Me.LOGOUT.Visible = False
End Sub
Private Sub Fotodimensi()
Dim Carifoto As String
Me.Imagedimensi.Picture = Sheet3.Range("B2").Value
Set Carifoto = Sheet3.Range("A2:A100").Find(WHAT:=Me.Imagedimensi.Picture, LookIn:=xlValues)
Me.Imagedimensi.Picture = LoadPicture(Carifoto.Offset(0, 1).Value)
End Sub
STEP 8. TOMBOL PANGGIL DATA SALES
Private Sub PANGGILNAMA()
On Error GoTo SALAH
If Me.TXT_NAMA.Value = "" Then
Call MsgBox("Masukkan nama sales yang dicari", vbInformation, "Cari Sales")
Else
Sheet3.Range("C2").Value = Me.TXT_NAMA.Value
Set CARISALES = Sheet2.Range("A2:A100").Find(WHAT:=Me.TXT_NAMA.Value, LookIn:=xlValues)
Me.FOTOSALES.Picture = LoadPicture(CARISALES.Offset(0, 2).Value)
Me.NAMASALES.Caption = CARISALES.Offset(0, 0).Value
Me.IDSALES.Caption = CARISALES.Offset(0, 1).Value
Call BukaGrafik
End If
Exit Sub
SALAH:
Call MsgBox("Data sales tidak ditemukan", vbInformation, "Cari Sales")
End Sub
STEP 9. TOMBOL CLOSE
Private Sub Menu5_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
ThisWorkbook.Save
ThisWorkbook.Close
End Sub
STEP 10. HIDE TITLE BAR
BUAT MODUL BARU LALU TARUH CODE DI BAWAH KE MODUL
Option Explicit
Option Private Module
Public Const GWL_STYLE = -16
Public Const WS_CAPTION = &HC00000
#If VBA7 Then
Public Declare PtrSafe Function GetWindowLong _
Lib "user32" Alias "GetWindowLongA" ( _
ByVal hwnd As LongPtr, _
ByVal nIndex As Long) As Long
Public Declare PtrSafe Function SetWindowLong _
Lib "user32" Alias "SetWindowLongA" ( _
ByVal hwnd As LongPtr, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Public Declare PtrSafe Function DrawMenuBar _
Lib "user32" ( _
ByVal hwnd As LongPtr) As Long
Public Declare PtrSafe Function FindWindowA _
Lib "user32" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As LongPtr
#Else
Public Declare Function GetWindowLong _
Lib "user32" Alias "GetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong _
Lib "user32" Alias "SetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Public Declare Function DrawMenuBar _
Lib "user32" ( _
ByVal hwnd As Long) As Long
Public Declare Function FindWindowA _
Lib "user32" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
#End If
Sub HideTitleBar(frm As Object)
#If VBA7 Then
Dim lFrmHdl As LongPtr
#Else
Dim lFrmHdl As Long
#End If
Dim lngWindow As Long
lFrmHdl = FindWindowA(vbNullString, frm.Caption)
lngWindow = GetWindowLong(lFrmHdl, GWL_STYLE)
lngWindow = lngWindow And (Not WS_CAPTION)
Call SetWindowLong(lFrmHdl, GWL_STYLE, lngWindow)
Call DrawMenuBar(lFrmHdl)
End Sub
Sub ShowTitleBar(frm As Object)
#If VBA7 Then
Dim lFrmHdl As LongPtr
#Else
Dim lFrmHdl As Long
#End If
Dim lngWindow As Long
lFrmHdl = FindWindowA(vbNullString, frm.Caption)
lngWindow = GetWindowLong(lFrmHdl, GWL_STYLE)
lngWindow = lngWindow + (WS_CAPTION)
Call SetWindowLong(lFrmHdl, GWL_STYLE, lngWindow)
Call DrawMenuBar(lFrmHdl)
End Sub
STEP 11. CODE UNTUK MENGGESER USERFORM
‘Letakkan di Userform paling atas
Private m_sngDownX As Single
Private m_sngDownY As Single
‘Letakkan di userform
Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single,
ByVal Y As Single)
If Button = 1 Then
m_sngDownX = X
m_sngDownY = Y
End If
End Sub
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single,
ByVal Y As Single)
If Button And 1 Then
Me.Left = Me.Left + (X - m_sngDownX)
Me.Top = Me.Top + (Y - m_sngDownY)
End If
End Sub
Private Sub PANGGILMATERIAL()
Dim CARIMATERIAL As String
Me.BOX1.Value = Sheet2.Range("C2").Value
Set CARIMATERIAL = Sheet5.Range("E4:E10").Find(WHAT:=Me.BOX1.Value, LookIn:=xlValues)
Me.FOTO2.Picture = (CARIMATERIAL.Offset(0, 0).Value)
Me.BOX1.Caption = (CARIMATERIAL.Offset(0, 1).Value)
End Sub
Private Sub Fotodimensi()
Dim Carifoto As String
Me.Imagedimensi.Picture = Sheet3.Range("B2").Value
Set Carifoto = Sheet3.Range("A2:A100").Find(WHAT:=Me.Imagedimensi.Picture, LookIn:=xlValues)
Me.Imagedimensi.Picture = LoadPicture(Carifoto.Offset(0, 1).Value)
End Sub
Me.TABEL_PEMAKAIAN.RowSource = Sheet3.Range("TABEL_KEBUTUHAN").Address(exsternal:=True)
Me.TABEL_PEMAKAIAN.ColumnCount = 2
Me.TABEL_PEMAKAIAN.List = Sheets (“DATA_DASHBOARD”).Range(“BC:C5”).Curentregion.value
Sub Grafik()
Dim pshp As Shape
Dim xrg As Range
Dim xcol As Long
Dim grafiklist() As Variant
On Error Resume Next
Application.ScreenUpdating = False
Set panggilgrafik = Sheet3.Range("b2:b10")
For Each cell In panggilgrafik
Filename = cell
Sheet3.Pictures.Insert(Filename).Select
Set pshp = Selection.ShapeRange.Item(1)
If pshp Is Nothing Then GoTo lab
xcoll = cell.Column + 1
Set xrg = Cells(cell.Row, xcol)
With pshp
