Sistem Absensi Dan Laporan Penggajian

Template Invoice dan Laporan Penjualan

Salam...,

Pada tutorial Pemograman VBA microsoft Excell kali ini saya membuat Template Invoice dan Laporan Penjualan, bagaimana supaya dengan mudah, dan cepat dalam proses pembuatan Invoice dan gampang untuk melihat setiap transaksi nya.Tutorial yang saya buat kali ini terdiri dari beberapa Sesion:

Sesion # 01. Membuat Worksheets Proudct


Formula : 

Cell M9 =IFERROR(INDEX(Category_Product,MATCH(0,COUNTIF($M$8:M8,Category_Product),0)),"")
Press Ctrl + Shift and Enter
Cell B7  =COUNT(B9:B999)
Cell H9 = IF($F9="","",SUMIF(OutCode,$F9,OutQty))
Cell I9 = IF($F9="","",SUMIF(InCode,$F9,InQty)-H9)
Cell J9 = IF(I9="","",IF(I9<=0,"Out of Stock",IF(I9<=50,"Reorder Now","Stock Fine")))

Gambar Show Formula WorkSheets Product

Membuat Conditional Formating Cell :

 Cell J9 : J1000;
  • Stock Fine
  • Reoder Now
  • Out Of Stock

 


Dynamic Name Manager :
  •  AddNewProductClear  =Product!$C$3:$G$3
  • Category = OFFSET(Product!$M$9,,,COUNTA(Product!$M$9:$M$1000))
  •  Category_Product =Product!$D$9:$D$1000
  • Item_Product =OFFSET(Product!$D$9,,,COUNTA(Product!$D$9:$D$1000),4)
  • Quick_Copy =OFFSET(Product!$B$9,,,MATCH(9.99999999999999E+307,Product!$B$9:$B$1000))
  • Quick_paste =Invoice!$E$27:$G$36


Module Code :

Sub Update()
'error handler
On Error GoTo Excell_Invoice
'hold in memory
Application.ScreenUpdating = False
'dimention variable
Dim ws As Worksheet
'set worksheet variable
Set ws = Worksheets("Sales")
'reset the named ranges
ws.Activate
With ws
.Range("F5:F" & Cells(Rows.Count, "F").End(xlUp).Row).Name = "OutCode"
.Range("E5:E" & Cells(Rows.Count, "E").End(xlUp).Row).Name = "OutQty"
End With
'if error occurs
On Error GoTo 0
Exit Sub
Excell_Invoice:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Update of Module CopyTo"
End Sub

Sub Add_Product()
On Error GoTo Excell_Invoice
Dim DstRng As Range 'destination range
'Set DstRng = Sheet3.range("C5")
Set DstRng = Worksheets("Product").Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)
Set ws = Worksheets("Product")
Application.ScreenUpdating = False
If ws.Range("C3") = "" Then
MsgBox "It appear that you have forgotten to add the date"
Exit Sub
ElseIf ws.Range("D3") = "" Then
MsgBox "The quantity is missing"
Exit Sub
ElseIf ws.Range("E3") = "" Then
MsgBox "Please add the Description"
Exit Sub
Else

'give the user a chance to exit here
Select Case MsgBox _
("You are about to add stock." _
& vbCrLf & "Check everything before you proceed", _
vbYesNo Or vbExclamation, "Are you sure?")
Case vbYes
Case vbNo
Exit Sub
End Select

'copy and paste data without selecting,first sheet,sourse variable
Set SrcRng1 = Worksheets("Product").Range("AddNewProductClear")
SrcRng1.Copy
DstRng.PasteSpecial xlPasteValues
'sort data and reset named range
With ws
.Range("C8:J10000").Sort Key1:=Worksheets("Product").Range("D8"), Order1:=xlAscending, Header:=xlGuess
End With
'empty clipboard
Application.CutCopyMode = False
'confirmation message
MsgBox "Your stock hase been has been added." _
& vbCrLf & "and the totals have been sent to Accounts"
'clear the invoicce
Worksheets("Product").Range("AddNewProductClear").ClearContents
Worksheets("Product").Select
Application.ScreenUpdating = False
End If

'error handler
Exit Sub
Excell_Invoice:
MsgBox " We have a problem"
End Sub

Sub Copy_to_Invoice()
Dim ws As Worksheet
Dim cell As Range
Dim Nrow As Range
'error handler
On Error GoTo AnError:
'check there is a range
'sheet variable
Set ws = Worksheets("Product")
If ws.Range("B7").Value = 0 Then
MsgBox "There are no quick picks filled in"
Exit Sub
End If
'check if the data will fit
If Worksheets("Invoice").Range("K3").Value + Worksheets("Product").Range("B7").Value >= 40 Then
MsgBox "There are too many items on the invoice"
Exit Sub
End If
'give the user a chance to exit here
Select Case MsgBox _
("These values will be sent to the invoice." _
& vbCrLf & "Check Before Proceed", _
vbYesNo Or vbExclamation, "Are you sure?")
Case vbYes
Case vbNo
Exit Sub
End Select
'hold in  memory
Application.ScreenUpdating = False

'loop
For Each cell In ws.Range("Quick_Copy")
'find first cell to paste to

Set Nrow = Worksheets("Invoice").Cells(Rows.Count, "E").End(xlUp).Offset(1, 0)

'check for value
If cell.Value <> "" Then
'copy
'cell.range(ws.Cells(1, 1), ws.Cells(1, 3)).Copy
cell.Range("A1,C1:D1").Copy 'alternative with range reference
'paste
Nrow.PasteSpecial Paste:=xlPasteValues
'get location of next row
Nrow = Nrow
End If
'move to next row
Next cell
ws.Range("Quick_Copy").ClearContents
MsgBox "Gone to the invoice"
Application.CutCopyMode = False
Exit Sub
AnError:
MsgBox "We have a problem"

Application.ScreenUpdating = True
End Sub




No comments:

Post a Comment

Subscribe to: Posts (Atom)