跟着王老师学Excel VBA #19 | Excel+Access系统开发
概要
- 完成纯Excel版销售工具的开发
- 将程序数据库迁移至Access数据库 创建Access数据库 在Access数据库中查询商品信息 销售流水写入Access数据库
演示案例
- 创建门店销售工具
- 使用Access数据库
Notes
1. 连接代码
- Excel文件 Dim conn As New ADODB.Connection conn.Open "Provider = Microsoft.ACE.OLEDB.12.0;Data Source=D:\data\Edata.xlsx;extended properties=""excel 12.0;HDR=YES""" conn.Close
- ACCESS文件 strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=D:\data\Adata.accdb"
- Mysql数据库 strConn = "Provider=SQLOLEDB;DataSource=" & Path & ";Initial Catolog=" & strDataName
- MSSQL数据库 strConn = "Provider=MSDASQL;Driver={SQL Server};Server=" & Path & ";Database=" & strDataName
- Oracle数据库 strConn = "Provider=madaora;Data Source=MyOracleDB; User Id=UserID; Password=Password"
2. 保护代码 工具 - VBAProject 属性 - 保护 - 查看时锁定工程
3. 强制要求变量声明 Option Explicit 工具 - 选项 - 要求变量声明
'删除列表框的项目
Private Sub CommandButton1_Click()
For i = 0 To Sheet1. ListBox1. ListCount -1
If Me. ListBox1. Selected(i) = True Then
Me. ListBox1. RemoveItem i
End If
Next
End Sub
'将当前时间作为订单号
Range("A1") = "D"&Format(VBA. Now, "YYYYMMDDHHMMSS")
⭐用Access数据库制作门店销售系统界面
'连接数据库
Private Sub Workbook_Open
Dim conn As New ADODB.Connection '工具 - 引用 - Microsoft ActiveX Data Objects
sheet1. Range("A2:F1000"). ClearContents
conn. Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=D:\data\bak.mp3" '保护公共盘的database
Sheet1. Range("A2"). CopyFromRecordset conn Execute("select * from [产品信息]")
conn. Close
End Sub
--------
插入-用户窗体
Dim arr() '定义公共变量
Dim ID As String
Dim DJ As Long
--------
'添加商品至购物列表
Private Sub CommanButton1_Click() '点击“添加”按钮
If Me. ListBox1. Value<>"" And Me. L istBox2. Value<>"" And Me. ListBox3. Value<>"" And Me. TextBox1>0 Then
Me. ListBox4. AddItem
Me. ListBox4. List(Me.ListBox4. ListCount-1,0) = ID
Me. ListBox4. List(Me.ListBox4. ListCount-1,1) = Me. ListBox1. Value
Me. ListBox4. List(Me.ListBox4. ListCount-1,2) = Me. ListBox2. Value
Me. ListBox4. List(Me.ListBox4. ListCount-1,3) = Me. ListBox3. Value
Me. ListBox4. List(Me.ListBox4. ListCount-1,4) = Me. TextBox1. Value
Me. ListBox4. List(Me.ListBox4. ListCount-1,5) = Me. TextBox1. Value * Me. Label2. Caption
Else
MsgBox "请正确选择商品"
End If
Me. Label5. Caption = Me. Label5. Caption + Me. TextBox1. Value * Me. Label2. Caption
End Sub
--------
'删除列表框的项目
Private Sub CommandButton2_Click()
For i = 0 To Sheet1. ListBox4. ListCount -1
If Me. ListBox4. Selected(i) = True Then
Me. Label5. Caption = Me. Label5. Caption - Me. ListBox4. List(i,5)
Me. ListBox4. RemoveItem i
End If
Next
End Sub
--------
'结算当前订单，写入销售记录
Private Sub CommandButton3_Click()
Dim DDID As String
Dim conn As New ADODB. Connetion
Dim str As String
If Me. ListBox4. ListCount > 0 Then
DDID = "D"&Format(VBA. Now, "YYYYMMDDHHMMSS")
conn. Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=D:\data\bak.mp3"
For i = 0 To Me. ListBox4. ListCount -1
str = " (' " & DDID & " ',' " & Date & " ',' " & Me. ListBox4. List(i,0) & " ', " & Me. ListBox4. List(i,4) & " , " & Me. ListBox4. List(i,5) & " ) "
conn. Execute ("insert into [销售记录] (订单号，日期，产品编号，数量，金额) values " & str )
Next
conn. Close
MsgBox "结算成功"
Unload Me
Else
MsgBox "购物清单为空"
End If
End Sub
--------
Private Sub ListBox1_Click()
Dim dic
Set dic = CreateObject("Scripting. Dictionary")
Me. ListBox2. Clear
For i = Lbound(arr) To Ubound(arr)
If arr(i,2) = Me.ListBox1. Value Then
dic(arr(i,3)) = 1
End If
Next
Me. ListBox2. List = dic. Keys
Me. ListBox3. Clear '当一级重新选择时，清空三级的选框
Me. Label2. Caption = 0
End Sub
--------
Private Sub ListBox2_Click()
Dim dic
Me. ListBox3. Clear
Set dic = CreateObject("Scripting. Dictionary")
For i = Lbound(arr) To Ubound(arr)
If arr(i,2) = Me.ListBox1. Value And arr(i,3) = Me.ListBox2. Value Then
dic(arr(i,4)) = 1
End If
Next
Me. ListBox3. List = dic. Keys
Me. Label2. Caption = 0
End Sub
--------
Private Sub ListBox2_Click()
For i = Lbound(arr) To Ubound(arr)
If arr(i,2) = Me. ListBox1. Value and arr(i,3) = Me. ListBox2. Value and arr(i,4) = Me. ListBox3. Value Then
ID = arr(i,1)
DJ = arr(i,5)
End If
Next
Me. Label2. Caption = DJ
End Sub
--------
Private Sub UserForm_Activate()
Dim dic
arr = Sheet1. Range("B2:F" & Sheet1. Range("A65536"). End(xlUp). Row)
Set dic = CreateObject("Scripting. Dictionary")
For i = Lbound(arr) To Ubound(arr)
dic(arr(i,2)) = 1 '这里赋值成多少不是重点，关键是取得不重复的key
Next
Me. ListBox1. List = dic. Keys
End Sub
