0% found this document useful (0 votes)
7 views

CODING

Uploaded by

sintiyacarella
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as DOCX, PDF, TXT or read online on Scribd
0% found this document useful (0 votes)
7 views

CODING

Uploaded by

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

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

You might also like