购物卡充值系统c语言代码,超市购物卡销售、存取货管理系统

获取原文件：QQ1007467564

一、功能介绍：

最近，为一家超市定做一套购物卡销售、存取货管理系统，通过excelVba实现，主要功能分两大模块：购物卡销售及回收，存货及取货，模块设分级权限，用户按各自权限登陆，一级权限为超级权限，可以查看编辑所有表，售卡及回收，存货及取货按照各自权限分别登陆相应模块。其界面如下：

二、主要功能代码：

Sub

售卡保存()

Application.ScreenUpdating = False

If Cells(2, 5) = "" Or

Cells(2, 7) = "" Or Cells(3, 5) = "" Or Cells(3, 7) = ""

Then

MsgBox

"表头信息填写不全，请重新填写！"

Exit

Sub

End

If

With Sheets("数据表")

.Unprotect Password:="9"

End With

For W = 5 To Application.CountA(Sheets("售卡登记").Range("e5:e205")) + 4

r = Sheets("数据表").Range("A65536").End(xlUp).Row

Sheets("数据表").Cells(r + 1, 1) =

Sheets("售卡登记").Cells(2,

5)

Sheets("数据表").Cells(r + 1, 2) =

Sheets("售卡登记").Cells(2,

7)

Sheets("数据表").Cells(r + 1, 3) =

Sheets("售卡登记").Cells(3,

5)

Sheets("数据表").Cells(r + 1, 4) =

Sheets("售卡登记").Cells(3,

7)

For y = 1 To 2

Sheets("数据表").Cells(r + 1, y + 4)

= Sheets("售卡登记").Cells(W, y +

4)

Next

Next

'ActiveWindow.SelectedSheets.PrintOut Copies:=1,

Collate:=True

Range("E3,g2:g3,e5:g204").Select

Selection.ClearContents

Range("e5").Select

Range("g2").Select

With Sheets("数据表")

.Protect Password:="9", DrawingObjects:=True, Contents:=True,

Scenarios:=True _

, AllowFormattingCells:=True, AllowFormattingColumns:=True,

_

AllowFormattingRows:=True '保护工作表，并设置密码

End With

MsgBox "数据已保存到“数据表”",

vbInformation, "保存提示"

Sheets("售卡登记").Select

ActiveWindow.ScrollRow = 1

ActiveWindow.ScrollColumn = 1

Application.ScreenUpdating = True

End Sub

Sub

生成金额()

Application.ScreenUpdating = False

W = Application.CountA(Sheets("回收登记").Range("d3:d202")) + 2

With Sheets("数据表")

For i = 3 To W

Set k = .Range("e:e").Find(Cells(i, 4), LookIn:=xlValues,

LOOKAT:=xlWhole)

If Not k Is Nothing And .Cells(k.Row, 7) = "" Then

Cells(i, 5) = .Cells(k.Row, 6)

End If

Next

End With

Application.ScreenUpdating = True

End Sub

Sub

批量录入()

Application.ScreenUpdating = False

x = InputBox("输入起始卡号",

"删除起始行",

"输入删除起始卡号")

y = InputBox("输入终止卡号",

"删除终止卡号",

"输入删除终止卡号")

k = InputBox("输入面值",

"面值", "输入面值")

j = 0

For i = 5 To 5 + y -

x

Cells(i,

5) = x + j

Cells(i,

6) = k

j = j +

1

Next

Application.ScreenUpdating = True

End Sub

Sub

查询()

Application.ScreenUpdating = False

Application.CutCopyMode = False

Sheets("查询表").Select

If ActiveSheet.AutoFilterMode Then

Selection.AutoFilter

End

If

Cells.Select

Selection.Clear

a = Sheets("数据表").Range("A65536").End(xlUp).Row

Sheets("数据表").Range("A1:h65536").Copy

Sheets("查询表").Range("a1").PasteSpecial

'Paste:=xlPasteValues '选择性粘贴

a = Range("A65536").End(xlUp).Row + 1

Cells(a, 1) = "合计"

'Range("M" & a).Select

'ActiveCell.FormulaR1C1 =

"=SUBTOTAL(9,R2C:R&a&C)"

Cells(a, 6) = "=SUBTOTAL(9,f1:f" & a - 1 & ")"

With Range(Cells(1, 1), Cells(a, 8))

.Borders.LineStyle = xlContinuous

.Font.Size = 10

'.RowHeight = 15

.WrapText = True '自动换行

.Rows.AutoFit '最合适行高

End With

Range("A1").Select

Application.CutCopyMode = False

Selection.AutoFilter

Rows("1:1").Select

Selection.RowHeight = 30

Range("A1").Select

Application.CutCopyMode = False '清空剪贴板

MsgBox "计算完毕,本表作查询用，可随意编辑，随时刷新", vbInformation, "计算完毕"

'ActiveWindow.ScrollRow = 1

'ActiveWindow.ScrollColumn = 1

End

Sub

Sub

取货保存()

Application.ScreenUpdating = False

a =

MsgBox("请核对数据，确认保存吗",

vbExclamation + vbYesNo, "保存提示")

If a = vbNo Then Exit Sub

With

Sheets("存取货数据")

.Unprotect

Password:="9"

End With

With

Sheets("存取货数据")

a = Sheets("存取货数据").Range("A65536").End(xlUp).Row + 1

For i = 2 To

.Range("a65536").End(xlUp).Row

If .Cells(i, 2)

& .Cells(i, 3) & .Cells(i, 4) & .Cells(i, 5) = Cells(9,

3) & Cells(9, 4) & Cells(9, 5) & Cells(9, 6)

Then

If

.Cells(i, 11) = "" Then

.Cells(i, 11) = Month(Cells(9, 2)) & "-" & Day(Cells(9,

2))

.Cells(i, 12) = Cells(9, 8)

.Cells(i,

13) = .Cells(i, 13) - Cells(9, 8)

Else

.Cells(i, 11) = .Cells(i, 11) & Chr(10) & Month(Cells(9,

2)) & "-" & Day(Cells(9, 2))

.Cells(i, 12) = .Cells(i, 12) & Chr(10) & Cells(9,

8)

.Cells(i, 13) = .Cells(i, 13) - Cells(9, 8)

End

If

If .Cells(i, 13)

< 0 Then

MsgBox

"该客户结存出现负数，请查实！"

End If

Exit For

End If

Next

End With

'ActiveWindow.SelectedSheets.PrintOut Copies:=1,

Collate:=True

Sheets("取货登记").Select

Range("c9:h9").Select

Selection.ClearContents

Range("c9").Select

With Sheets("存取货数据")

.Protect Password:="9", DrawingObjects:=True, Contents:=True,

Scenarios:=True _

, AllowFormattingCells:=True, AllowFormattingColumns:=True,

_

AllowFormattingRows:=True '保护工作表，并设置密码

End With

MsgBox "数据已保存到“存取货数据表”",

vbInformation, "保存提示"

Sheets("取货登记").Select

Application.ScreenUpdating = True

End

Sub