Download miễn phí Tìm hiểu ngôn ngữ Visual Basic
Phần I NộI dung
GiớI thiệu về ngôn ngữ Visual Basic
Lập trình vớI ngôn ngữ Visual Basic
Cấu trúc của một chương trình viết bằng ngôn ngữ Visual Basic
Phần II Mục đích và yêu cầu của phần mềm
Chức năng chính của Phần mềm Quản lý thu mua chè
Cơ sở dữ liệu
Phần III Mã nguồn chương trình
Để tải tài liệu này, vui lòng Trả lời bài viết, Mods sẽ gửi Link download cho bạn ngay qua hòm tin nhắn.
Ketnooi -
You must be registered for see links
Ai cần tài liệu gì mà không tìm thấy ở Ketnooi, đăng yêu cầu down tại đây nhé:
Nhận download tài liệu miễn phí
Tóm tắt nội dung tài liệu:
cßn l¹i hay kh«ng ?", vbYesNo
If MsgAns = vbNo Then
Exit Sub
ElseIf MsgAns = vbYes Then
HDNo = True
End If
End If
Call SaveData
'--------------- In hoa don ---------------------
If chkKoIn.Value = 0 Then
With Rpt_HoaDon
.lblNgay.Caption = Date
.lblDiachi.Caption = txtDiachi.Text
.lblMaHD.Caption = lblMaHD.Caption
.lblTenKH.Caption = txtTenKH.Text
.lblKhoiLuongSau.Caption = lblTongKL.Caption
.lblTongtien.Caption = lblTongtien.Caption
.lblUser.Caption = UserName
.lblKlA.Caption = lblA.Caption
.lblKlB.Caption = lblB.Caption
.lblKlC.Caption = lblC.Caption
.lblKlD.Caption = lblD.Caption
RsOldData.MoveFirst
Do Until RsOldData.EOF
If RsOldData.Fields(0) = "Lo¹i A" Then
.lblGiaA = RsOldData.Fields(1)
.lblTienA = Format(CDbl(.lblGiaA) * CDbl(.lblKlA), "#,###")
End If
If RsOldData.Fields(0) = "Lo¹i B" Then
.lblGiaB = RsOldData.Fields(1)
.lblTienB = Format(CDbl(.lblGiaB) * CDbl(.lblKlB), "#,###")
End If
If RsOldData.Fields(0) = "Lo¹i C" Then
.lblGiaC = RsOldData.Fields(1)
.lblTienC = Format(CDbl(.lblGiaC) * CDbl(.lblKlC), "#,###")
End If
If RsOldData.Fields(0) = "Lo¹i D" Then
.lblGiaD = RsOldData.Fields(1)
.lblTienD = Format(CDbl(.lblGiaD) * CDbl(.lblKlD), "#,###")
End If
RsOldData.MoveNext
Loop
.Show
End With
End If
Call cmdNew_Click
'Call update(lblMaHD)
End Sub
Private Sub cmdSave_Click()
On Error Resume Next
If txtKhoiLuongTruoc.Text = "0" Then
MsgboxC "Kh«ng thÓ nhËp tiÕp hµng nÕu kh«ng cã ®ñ d÷ liÖu !", vbInformation
txtKhoiLuongTruoc.SetFocus
Exit Sub
End If
If curPos = 0 Then
Exit Sub
End If
If NewH = True Then
lv.ListItems.Add , , lv.ListItems.Count + 1
curPos = lv.ListItems.Count
NewH = False
End If
Call addHang(curPos)
End Sub
Private Sub Form_Load()
On Error Resume Next
curPos = 1
'****** Add combo
cmbLoai1.AddItem "Lo¹i A"
cmbLoai1.AddItem "Lo¹i B"
cmbLoai1.AddItem "Lo¹i C"
cmbLoai1.AddItem "Lo¹i D"
cmbLoai2.AddItem "Lo¹i A"
cmbLoai2.AddItem "Lo¹i B"
cmbLoai2.AddItem "Lo¹i C"
cmbLoai2.AddItem "Lo¹i D"
cmbLoai1.Text = cmbLoai1.list(0)
cmbLoai2.Text = cmbLoai2.list(1)
'************************
lblMaHD.Caption = AutoKey
imgNav.ListImages.Add , , LoadResPicture("back_dis", 1)
imgNav.ListImages.Add , , LoadResPicture("foward_dis", 1)
imgNav.ListImages.Add , , LoadResPicture("back", 1)
imgNav.ListImages.Add , , LoadResPicture("foward", 1)
imgNav.ListImages.Add , , LoadResPicture("back_click", 1)
imgNav.ListImages.Add , , LoadResPicture("foward_click", 1)
Call DefControls
NewH = True
End Sub
Private Sub Check1_Click()
On Error Resume Next
If Check1.Value = True Then
chkTyleChe.Value = 0
sFrame.Width = 6435
frmLoai2.Visible = True
chkTyleChe.Enabled = True
txtTyleChe.Enabled = True
Else
chkTyleChe.Enabled = False
chkTyleChe.Value = 0
sFrame.Width = 3435
frmLoai2.Visible = False
txtTyleChe.Text = "100"
txtTyleChe.Enabled = False
End If
End Sub
Public Sub TinhTien()
On Error Resume Next
Dim KNuoc As Double 'Khoi luong nuoc trong che
Dim Ktruoc As Double 'Khoi luong ban dau
Dim Ksau As Double 'Khoi luong sau
Dim Che1 As Double 'Khoi luong loai1
Dim Che2 As Double 'Khoi luong loai2
Dim Tong 'As Double
Dim Baobi As Double ' khoi luong bao bi
'##########################################
'Cong thuc tinh
' Khoi luong nuoc = (Khoi luong ban dau - Khoi luong bao bi ) * (Ty le nuoc)
' Khoi luong sau = (Khoi luong truoc) - (Khoi luong nuoc) - (Bao bi)
'-------------------------------------------------------------------------
Ktruoc = CDbl(txtKhoiLuongTruoc.Text)
Baobi = CDbl(txtBaoBi.Text)
KNuoc = (Ktruoc - Baobi) * CDbl(txtTylenuoc.Text) / 100
If chkTyleNuoc.Value = 0 And chkBaobi.Value = 0 Then
lblKhoiLuongSau.Caption = Ktruoc
End If
If chkTyleNuoc.Value = 1 And chkBaobi.Value = 0 Then
lblKhoiLuongSau.Caption = Ktruoc - KNuoc
End If
If chkTyleNuoc.Value = 0 And chkBaobi.Value = 1 Then
lblKhoiLuongSau.Caption = Ktruoc - Baobi
End If
If chkTyleNuoc.Value = 1 And chkBaobi.Value = 1 Then
lblKhoiLuongSau.Caption = Ktruoc - KNuoc - Baobi
End If
Ksau = CDbl(lblKhoiLuongSau.Caption)
If Check1.Value = 0 Then
Che1 = Ksau
Che2 = 0
Else
Che1 = Ksau * CDbl(txtTyleChe.Text) / 100
Che2 = Ksau - (Ksau * CDbl(txtTyleChe.Text) / 100)
End If
Tong = (Che1 * CDbl(txtGia1.Text)) + (Che2 * CDbl(txtGia2.Text))
Tong = Round(Tong, 0)
'----------------------------------------------------------------------
'Quy t¾c lµm trßn : cã 2 lo¹i lµm trßn do biÕn RoundUp (Boolean) quyÕt ®Þnh
' +> RoundUp=True : lµm trßn lªn . NÕu sè lÎ >500 vµ < 1000 th× lµm trßn lªn 1000
' NÕu sè lÎ < 500 thi trßn thµnh 500
' +> RoundUp=False : lµm trßn xuèng . NÕu sè lÎ >500 vµ < 1000 th× lµm trßn xuèng 500
' NÕu sè lÎ < 500 thi trßn thµnh 0
'----------------------------------------------------------------------
If (Tong Mod 1000) > 500 Then
If RoundUp = True Then ' Lµm trßn lªn
Tong = Tong - (Tong Mod 1000) + 1000
Else ' lµm trßn xuèng
Tong = Tong - (Tong Mod 1000) + 500
End If
End If
If (Tong Mod 1000) < 500 Then
If RoundUp = True Then
Tong = Tong - (Tong Mod 1000) + 500
Else
Tong = Tong - (Tong Mod 1000)
End If
End If
' Hµm FormatMoney sÏ ®a ra ®Þnh d¹ng kiÓu tiÒn .
'VD 1110000 sÏ ®îc chuyÓn thµnh 1,100,000
lblThanhTien.Caption = FormatMoney(Tong)
If lblThanhTien.Caption = "" Then
lblThanhTien.Caption = "0"
End If
End Sub
Private Sub DisplayPos(CurP As Integer)
On Error Resume Next
Dim i As Byte
With lv.ListItems(CurP)
txtKhoiLuongTruoc.Text = .SubItems(1)
For i = 0 To 3
If cmbLoai1.list(i) = .SubItems(2) Then
cmbLoai1.Text = cmbLoai1.list(i)
Exit For
End If
Next i
txtTyleChe.Text = .SubItems(3)
If .SubItems(4) "" Then
Check1.Value = True
For i = 0 To 3
If cmbLoai2.list(i) = .SubItems(4) Then
cmbLoai2.Text = cmbLoai2.list(i)
Exit For
End If
Next i
lblTyle.Caption = .SubItems(5)
Else
Check1.Value = False
End If
Check1_Click
If .SubItems(6) "0" Then
txtBaoBi.Text = .SubItems(6)
Else
txtBaoBi.Text = "0"
chkBaobi.Value = 0
End If
If .SubItems(7) "0" Then
txtTylenuoc.Text = .SubItems(7)
Else
txtTylenuoc.Text = "0"
chkTyleNuoc.Value = 0
End If
lblKhoiLuongSau.Caption = .SubItems(8)
lblThanhTien.Caption = .SubItems(9)
End With
End Sub
Private Sub SaveData()
' On Error Resume Next
Dim maKH As String
Dim tien As String
maKH = AutoKH
With RsHoaDon
.AddNew
.Fields(0) = lblMaHD.Caption
.Fields(1) = maKH
.Fields(2) = UserName
.Fields(3) = Date
.Fields(5) = CDbl(lblTongKL.Caption)
.Fields(4) = CDbl(lblTongtien.Caption)
If HDNo = True Then
RsTongTien.MoveFirst
.Fields(6) = CDbl(lblTongtien.Caption) - CDbl(RsTongTien.Fields(0))
RsTongTien.Fields(0) = "0"
RsTongTien.update
ElseIf HDNo = False Then
With RsTongTien
.MoveFirst
tien = .Fields(0)
.MoveFirst
.Fields(0) = CDbl(tien) - CDbl(lblTongtien.Caption)
.update
End With
End If
.update
End With
If lblA.Caption "0" Then
Call SaveND(RsNoiDungMua, lblMaHD.Caption, "Lo¹i A", lblA.Caption)
End If
If lblB.Caption "0" Then
Call SaveND(RsNoiDungMua, lblMaHD.Caption, "Lo¹i B", lblB.Caption)
End If
If lblC.Caption "0" Then
Call SaveND(RsNoiDungMua, lblMaHD.Caption, "Lo¹i C", lblC.Caption)
End If
If lblD.Caption "0" Then
Call SaveND(RsNoiDungMua, lblMaHD.Caption, "Lo¹i D", lblD.Caption)
End If
With rsKhachHang
.AddNew
.Fields(0) = maKH
.Fields(1) = txtTenKH.Text
.Fields(2) = txtDiachi.Text
.update
End With
End Sub
Private Sub newHang() ' Khoi tao lai cac Control khi chon nhap them hang
On Error Resume Next
EditHD = False
txtBaoBi.Text = "0"
txtKhoiLuongTruoc.Text = "0"
txtTylenuoc.Text = "0"
chkBaobi.Value = False
chkTyleNuoc.Value = False
Check1.Value = 0
Check1_Click
txtKhoiLuongTruoc.SetFocus
End Sub
Private Sub DefControls()
EditHD = False
lblNote.Caption = ""
lblMaHD.Caption = AutoKey
sFrame.Width = 3435
frmLoai2.Visible = False
End Sub
Private Sub EnableCont()
On Error Resume Next
txtKhoiLuongTruoc.Enabled = True
Check1.Enabled = True
chkTyleNuoc.Enabled = True
chkBaobi.Enabled = True
cmbLoai1.Enabled = True
End Sub
Private Sub ReOrder()
On Error Resume Next
Dim i As Integer
Call ReSum
If lv.ListItems.Count <= 0 Then
Exit Sub
End If
For i = 1 To lv.ListItems.Count
lv.ListItems(i).Text = i
Next i
End Sub
Private Sub ReSum()
On Error Resume Next
lblA.Caption = "0"
lblB.Caption = "0"
lblC.Caption = "0"
lblD.Caption = "0"
lblTongBB.Caption = "0"
lblTongKL.Caption = "0"
lblTongtien.Caption = "0"
If lv.ListItems.Count <= 0 Then
Exit Sub
End If
Dim i As Integer
Dim A As Double
Dim B As Double
Dim C As Double
Dim D As Double
Dim Per As Double
A = 0
B...
If MsgAns = vbNo Then
Exit Sub
ElseIf MsgAns = vbYes Then
HDNo = True
End If
End If
Call SaveData
'--------------- In hoa don ---------------------
If chkKoIn.Value = 0 Then
With Rpt_HoaDon
.lblNgay.Caption = Date
.lblDiachi.Caption = txtDiachi.Text
.lblMaHD.Caption = lblMaHD.Caption
.lblTenKH.Caption = txtTenKH.Text
.lblKhoiLuongSau.Caption = lblTongKL.Caption
.lblTongtien.Caption = lblTongtien.Caption
.lblUser.Caption = UserName
.lblKlA.Caption = lblA.Caption
.lblKlB.Caption = lblB.Caption
.lblKlC.Caption = lblC.Caption
.lblKlD.Caption = lblD.Caption
RsOldData.MoveFirst
Do Until RsOldData.EOF
If RsOldData.Fields(0) = "Lo¹i A" Then
.lblGiaA = RsOldData.Fields(1)
.lblTienA = Format(CDbl(.lblGiaA) * CDbl(.lblKlA), "#,###")
End If
If RsOldData.Fields(0) = "Lo¹i B" Then
.lblGiaB = RsOldData.Fields(1)
.lblTienB = Format(CDbl(.lblGiaB) * CDbl(.lblKlB), "#,###")
End If
If RsOldData.Fields(0) = "Lo¹i C" Then
.lblGiaC = RsOldData.Fields(1)
.lblTienC = Format(CDbl(.lblGiaC) * CDbl(.lblKlC), "#,###")
End If
If RsOldData.Fields(0) = "Lo¹i D" Then
.lblGiaD = RsOldData.Fields(1)
.lblTienD = Format(CDbl(.lblGiaD) * CDbl(.lblKlD), "#,###")
End If
RsOldData.MoveNext
Loop
.Show
End With
End If
Call cmdNew_Click
'Call update(lblMaHD)
End Sub
Private Sub cmdSave_Click()
On Error Resume Next
If txtKhoiLuongTruoc.Text = "0" Then
MsgboxC "Kh«ng thÓ nhËp tiÕp hµng nÕu kh«ng cã ®ñ d÷ liÖu !", vbInformation
txtKhoiLuongTruoc.SetFocus
Exit Sub
End If
If curPos = 0 Then
Exit Sub
End If
If NewH = True Then
lv.ListItems.Add , , lv.ListItems.Count + 1
curPos = lv.ListItems.Count
NewH = False
End If
Call addHang(curPos)
End Sub
Private Sub Form_Load()
On Error Resume Next
curPos = 1
'****** Add combo
cmbLoai1.AddItem "Lo¹i A"
cmbLoai1.AddItem "Lo¹i B"
cmbLoai1.AddItem "Lo¹i C"
cmbLoai1.AddItem "Lo¹i D"
cmbLoai2.AddItem "Lo¹i A"
cmbLoai2.AddItem "Lo¹i B"
cmbLoai2.AddItem "Lo¹i C"
cmbLoai2.AddItem "Lo¹i D"
cmbLoai1.Text = cmbLoai1.list(0)
cmbLoai2.Text = cmbLoai2.list(1)
'************************
lblMaHD.Caption = AutoKey
imgNav.ListImages.Add , , LoadResPicture("back_dis", 1)
imgNav.ListImages.Add , , LoadResPicture("foward_dis", 1)
imgNav.ListImages.Add , , LoadResPicture("back", 1)
imgNav.ListImages.Add , , LoadResPicture("foward", 1)
imgNav.ListImages.Add , , LoadResPicture("back_click", 1)
imgNav.ListImages.Add , , LoadResPicture("foward_click", 1)
Call DefControls
NewH = True
End Sub
Private Sub Check1_Click()
On Error Resume Next
If Check1.Value = True Then
chkTyleChe.Value = 0
sFrame.Width = 6435
frmLoai2.Visible = True
chkTyleChe.Enabled = True
txtTyleChe.Enabled = True
Else
chkTyleChe.Enabled = False
chkTyleChe.Value = 0
sFrame.Width = 3435
frmLoai2.Visible = False
txtTyleChe.Text = "100"
txtTyleChe.Enabled = False
End If
End Sub
Public Sub TinhTien()
On Error Resume Next
Dim KNuoc As Double 'Khoi luong nuoc trong che
Dim Ktruoc As Double 'Khoi luong ban dau
Dim Ksau As Double 'Khoi luong sau
Dim Che1 As Double 'Khoi luong loai1
Dim Che2 As Double 'Khoi luong loai2
Dim Tong 'As Double
Dim Baobi As Double ' khoi luong bao bi
'##########################################
'Cong thuc tinh
' Khoi luong nuoc = (Khoi luong ban dau - Khoi luong bao bi ) * (Ty le nuoc)
' Khoi luong sau = (Khoi luong truoc) - (Khoi luong nuoc) - (Bao bi)
'-------------------------------------------------------------------------
Ktruoc = CDbl(txtKhoiLuongTruoc.Text)
Baobi = CDbl(txtBaoBi.Text)
KNuoc = (Ktruoc - Baobi) * CDbl(txtTylenuoc.Text) / 100
If chkTyleNuoc.Value = 0 And chkBaobi.Value = 0 Then
lblKhoiLuongSau.Caption = Ktruoc
End If
If chkTyleNuoc.Value = 1 And chkBaobi.Value = 0 Then
lblKhoiLuongSau.Caption = Ktruoc - KNuoc
End If
If chkTyleNuoc.Value = 0 And chkBaobi.Value = 1 Then
lblKhoiLuongSau.Caption = Ktruoc - Baobi
End If
If chkTyleNuoc.Value = 1 And chkBaobi.Value = 1 Then
lblKhoiLuongSau.Caption = Ktruoc - KNuoc - Baobi
End If
Ksau = CDbl(lblKhoiLuongSau.Caption)
If Check1.Value = 0 Then
Che1 = Ksau
Che2 = 0
Else
Che1 = Ksau * CDbl(txtTyleChe.Text) / 100
Che2 = Ksau - (Ksau * CDbl(txtTyleChe.Text) / 100)
End If
Tong = (Che1 * CDbl(txtGia1.Text)) + (Che2 * CDbl(txtGia2.Text))
Tong = Round(Tong, 0)
'----------------------------------------------------------------------
'Quy t¾c lµm trßn : cã 2 lo¹i lµm trßn do biÕn RoundUp (Boolean) quyÕt ®Þnh
' +> RoundUp=True : lµm trßn lªn . NÕu sè lÎ >500 vµ < 1000 th× lµm trßn lªn 1000
' NÕu sè lÎ < 500 thi trßn thµnh 500
' +> RoundUp=False : lµm trßn xuèng . NÕu sè lÎ >500 vµ < 1000 th× lµm trßn xuèng 500
' NÕu sè lÎ < 500 thi trßn thµnh 0
'----------------------------------------------------------------------
If (Tong Mod 1000) > 500 Then
If RoundUp = True Then ' Lµm trßn lªn
Tong = Tong - (Tong Mod 1000) + 1000
Else ' lµm trßn xuèng
Tong = Tong - (Tong Mod 1000) + 500
End If
End If
If (Tong Mod 1000) < 500 Then
If RoundUp = True Then
Tong = Tong - (Tong Mod 1000) + 500
Else
Tong = Tong - (Tong Mod 1000)
End If
End If
' Hµm FormatMoney sÏ ®a ra ®Þnh d¹ng kiÓu tiÒn .
'VD 1110000 sÏ ®îc chuyÓn thµnh 1,100,000
lblThanhTien.Caption = FormatMoney(Tong)
If lblThanhTien.Caption = "" Then
lblThanhTien.Caption = "0"
End If
End Sub
Private Sub DisplayPos(CurP As Integer)
On Error Resume Next
Dim i As Byte
With lv.ListItems(CurP)
txtKhoiLuongTruoc.Text = .SubItems(1)
For i = 0 To 3
If cmbLoai1.list(i) = .SubItems(2) Then
cmbLoai1.Text = cmbLoai1.list(i)
Exit For
End If
Next i
txtTyleChe.Text = .SubItems(3)
If .SubItems(4) "" Then
Check1.Value = True
For i = 0 To 3
If cmbLoai2.list(i) = .SubItems(4) Then
cmbLoai2.Text = cmbLoai2.list(i)
Exit For
End If
Next i
lblTyle.Caption = .SubItems(5)
Else
Check1.Value = False
End If
Check1_Click
If .SubItems(6) "0" Then
txtBaoBi.Text = .SubItems(6)
Else
txtBaoBi.Text = "0"
chkBaobi.Value = 0
End If
If .SubItems(7) "0" Then
txtTylenuoc.Text = .SubItems(7)
Else
txtTylenuoc.Text = "0"
chkTyleNuoc.Value = 0
End If
lblKhoiLuongSau.Caption = .SubItems(8)
lblThanhTien.Caption = .SubItems(9)
End With
End Sub
Private Sub SaveData()
' On Error Resume Next
Dim maKH As String
Dim tien As String
maKH = AutoKH
With RsHoaDon
.AddNew
.Fields(0) = lblMaHD.Caption
.Fields(1) = maKH
.Fields(2) = UserName
.Fields(3) = Date
.Fields(5) = CDbl(lblTongKL.Caption)
.Fields(4) = CDbl(lblTongtien.Caption)
If HDNo = True Then
RsTongTien.MoveFirst
.Fields(6) = CDbl(lblTongtien.Caption) - CDbl(RsTongTien.Fields(0))
RsTongTien.Fields(0) = "0"
RsTongTien.update
ElseIf HDNo = False Then
With RsTongTien
.MoveFirst
tien = .Fields(0)
.MoveFirst
.Fields(0) = CDbl(tien) - CDbl(lblTongtien.Caption)
.update
End With
End If
.update
End With
If lblA.Caption "0" Then
Call SaveND(RsNoiDungMua, lblMaHD.Caption, "Lo¹i A", lblA.Caption)
End If
If lblB.Caption "0" Then
Call SaveND(RsNoiDungMua, lblMaHD.Caption, "Lo¹i B", lblB.Caption)
End If
If lblC.Caption "0" Then
Call SaveND(RsNoiDungMua, lblMaHD.Caption, "Lo¹i C", lblC.Caption)
End If
If lblD.Caption "0" Then
Call SaveND(RsNoiDungMua, lblMaHD.Caption, "Lo¹i D", lblD.Caption)
End If
With rsKhachHang
.AddNew
.Fields(0) = maKH
.Fields(1) = txtTenKH.Text
.Fields(2) = txtDiachi.Text
.update
End With
End Sub
Private Sub newHang() ' Khoi tao lai cac Control khi chon nhap them hang
On Error Resume Next
EditHD = False
txtBaoBi.Text = "0"
txtKhoiLuongTruoc.Text = "0"
txtTylenuoc.Text = "0"
chkBaobi.Value = False
chkTyleNuoc.Value = False
Check1.Value = 0
Check1_Click
txtKhoiLuongTruoc.SetFocus
End Sub
Private Sub DefControls()
EditHD = False
lblNote.Caption = ""
lblMaHD.Caption = AutoKey
sFrame.Width = 3435
frmLoai2.Visible = False
End Sub
Private Sub EnableCont()
On Error Resume Next
txtKhoiLuongTruoc.Enabled = True
Check1.Enabled = True
chkTyleNuoc.Enabled = True
chkBaobi.Enabled = True
cmbLoai1.Enabled = True
End Sub
Private Sub ReOrder()
On Error Resume Next
Dim i As Integer
Call ReSum
If lv.ListItems.Count <= 0 Then
Exit Sub
End If
For i = 1 To lv.ListItems.Count
lv.ListItems(i).Text = i
Next i
End Sub
Private Sub ReSum()
On Error Resume Next
lblA.Caption = "0"
lblB.Caption = "0"
lblC.Caption = "0"
lblD.Caption = "0"
lblTongBB.Caption = "0"
lblTongKL.Caption = "0"
lblTongtien.Caption = "0"
If lv.ListItems.Count <= 0 Then
Exit Sub
End If
Dim i As Integer
Dim A As Double
Dim B As Double
Dim C As Double
Dim D As Double
Dim Per As Double
A = 0
B...