连接代码
'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"
'工作表打开,导入access数据
Private Sub Workbook_Open()
Dim conn As New ADODB.Connection
conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=D:\DATA\data.accdb"
Sheet1.Range("a2").CopyFromRecordset conn.Execute("select * from [产品信息]")
conn.Close
End Sub
'窗口代码
Dim arr()
Dim ID As String
Dim DJ As Long
Private Sub CommandButton1_Click()
'点击添加按钮,判断前面的值是否为空,然后添加到listbox4中,listbox4需要把columncount属性值改为6,表示有六列数据
If Me.ListBox1.Value <> "" And Me.ListBox2.Value <> "" And Me.ListBox3.Value <> "" And Me.TextBox1.Value <> "" And Me.TextBox1.Value > 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 Me.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 str As String
Dim conn As New ADODB.Connection
'结算,将数据添加到access库中
If Me.ListBox4.ListCount > 0 Then
DDID = "D" & Format(VBA.Now, "yyyymmddhhmmss")
conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=D:\DATA\data.accdb"
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
MsgBox "结算成功"
Unload Me
Else
MsgBox "购物清单为空"
End If
End Sub
Private Sub ListBox1_Click()
Dim dic
Set dic = CreateObject("Scripting.Dictionary")
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
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
End Sub
Private Sub ListBox3_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数组中
arr = Sheet1.Range("b2:f" & Sheet1.UsedRange.Rows.Count)
'定义字典
Set dic = CreateObject("Scripting.Dictionary")
For i = LBound(arr) To UBound(arr)
dic(arr(i, 2)) = 1
Next
Me.ListBox1.List = dic.keys
End Sub