应广大网友要求，现将 ExcelVBA 之企业进销存 V2.0 关键代码分享如下：
一、Excel 文件准备
用户名和密码保存处：
二、登陆窗体
打开 Excel 时启动窗体代码：
Enter 按钮代码：
Private Sub CommandButton1_Click()
Static n As Integer
Dim sh As Worksheet
Dim rng As Range
Set sh = Sheets("RegisterInfo")
Set rng = sh.[B:B].Find(LoginForm.TextBox1.Text, lookat:=xlWhole)
If Not rng Is Nothing Then
If LoginForm.TextBox2.Text = rng.Offset(0, 1).value Then
'MsgBox "Success Login !"
sh.Range("D" & rng.row).value = sh.Range("E" & rng.row)
sh.Range("E" & rng.row).value = Now()
LoginStatus = 1
Unload Me
Application.Visible = True
Sheets("Main").Select
Else
n = n + 1
If n > 3 Then
MsgBox "您输入的错误次数超过 3 次 ，系统退出，请稍后再试！"
Unload Me
Exit Sub
Else
MsgBox "Wrong password !"
End If
End If
Else
MsgBox "Account not exists!"
End If
End Sub
Exit 按钮代码：
Private Sub CommandButton2_Click()
Unload Me
ThisWorkbook.Save
ThisWorkbook.Close
End Sub
Register 按钮：
Private Sub Label3_Click()
RegisterForm.Show ‘启动注册窗体
End Sub
注册窗体：
注册按钮代码：
Private Sub CommandButton1_Click()
Dim sh As Worksheet
Dim n As Integer
Dim rng As Range
Set sh = Sheets("RegisterInfo")
Set rng = sh.[B:B].Find(RegisterForm.TextBox1.Text, lookat:=xlWhole)
n = sh.Cells(Rows.Count, 1).End(xlUp).row
If Not rng Is Nothing Then
MsgBox "This username exists! please change another!"
Else
Set rng = sh.[F:F].Find(RegisterForm.TextBox4.Text, lookat:=xlWhole)
If Not rng Is Nothing Then
With RegisterForm
sh.Range("A" & n + 1) = sh.Range("A" & n) + 1
sh.Range("B" & n + 1) = .TextBox1.Text
sh.Range("C" & n + 1) = .TextBox2.Text
sh.Range("D" & n + 1) = Now()
MsgBox "Success!"
End With
Else
MsgBox "You are not employee,can not register!"
End If
End If
End Sub
退出按钮代码：
Private Sub CommandButton2_Click()
Unload Me
End Sub
三、库存查询窗体
代码：
1、Query按钮代码
Private Sub CommandButton1_Click()
Dim con As Object
Dim rs As Object
Dim sql As String
Dim product As String
Set con = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
'建立数据库的连接
con.cursorlocation = 3
con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source= " & ThisWorkbook.FullName
product = StockQueryForm.ComboBox1.Text
' 多条件中，任意一条件均不能为空
sql = "select aa.product,IIF(aa.descr is null,'-',aa.descr)as description,IIF(aa.specs is null,'',aa.specs)as specs,IIF(aa.入库 is null,0,aa.入库)as 入库,IIF(bb.出库 is null,0,bb.出库) as 出库,IIF(aa.入库 is null,0,aa.入库)-IIF(bb.出库 is null,0,bb.出库) as 库存 from (SELECT a.product,a.descr,a.specs,IIF(sum(a.Wt) is null,0,sum(a.wt))as 入库 FROM [FinishedIn$] as a group by a.product,a.descr,a.specs having a.product is not null) as aa left join (SELECT b.product,b.descr,b.specs,IIF(sum(b.Wt) is null,0,sum(b.wt))as 出库 FROM [FinishedOut$] as b group by b.product,b.descr,b.specs having b.product is not null) as bb on aa.product=bb.product and aa.specs=bb.specs where aa.product like '%" & product & "%'"
Set rs = con.Execute(sql)
If rs.EOF And rs.BOF Then
StockQueryForm.ListBox1.Clear
StockQueryForm.ListBox1.ColumnWidths = "80;80;80;80;80;80"
StockQueryForm.ListBox1.ColumnCount = 6
MsgBox "Nothing found!"
Else
StockQueryForm.ListBox1.Clear
StockQueryForm.ListBox1.ColumnWidths = "80;80;80;80;80;80"
StockQueryForm.ListBox1.ColumnCount = 6
StockQueryForm.ListBox1.Font.Size = 14
StockQueryForm.ListBox1.AddItem rs.fields(0).name
StockQueryForm.ListBox1.List(StockQueryForm.ListBox1.ListCount - 1, 1) = rs.fields(1).name
StockQueryForm.ListBox1.List(StockQueryForm.ListBox1.ListCount - 1, 2) = rs.fields(2).name
StockQueryForm.ListBox1.List(StockQueryForm.ListBox1.ListCount - 1, 3) = rs.fields(3).name
StockQueryForm.ListBox1.List(StockQueryForm.ListBox1.ListCount - 1, 4) = rs.fields(4).name
StockQueryForm.ListBox1.List(StockQueryForm.ListBox1.ListCount - 1, 5) = rs.fields(5).name
Do While Not rs.EOF
StockQueryForm.ListBox1.AddItem rs(0).value
StockQueryForm.ListBox1.List(StockQueryForm.ListBox1.ListCount - 1, 1) = rs(1).value
StockQueryForm.ListBox1.List(StockQueryForm.ListBox1.ListCount - 1, 2) = rs(2).value
StockQueryForm.ListBox1.List(StockQueryForm.ListBox1.ListCount - 1, 3) = rs(3).value
StockQueryForm.ListBox1.List(StockQueryForm.ListBox1.ListCount - 1, 4) = rs(4).value
StockQueryForm.ListBox1.List(StockQueryForm.ListBox1.ListCount - 1, 5) = rs(5).value
rs.movenext
Loop
End If
StockQueryForm.ListBox1.AddItem "Total"
Dim i As Integer
Dim sum1 As Double, sum2 As Double, sum3 As Double
sum2 = 0
sum1 = 0
sum3 = 0
For i = 1 To StockQueryForm.ListBox1.ListCount - 1
Dim value As Double
If IsNumeric(StockQueryForm.ListBox1.List(i, 3)) Then
value = CDbl(StockQueryForm.ListBox1.List(i, 3))
sum1 = sum1 + value
Else
' MsgBox "非数值数据: " &
StockQueryForm.ListBox1.List(i, 3)
End If
If IsNumeric(StockQueryForm.ListBox1.List(i, 4)) Then
value = CDbl(StockQueryForm.ListBox1.List(i, 4))
sum2 = sum2 + value
Else
' MsgBox "非数值数据: " &
StockQueryForm.ListBox1.List(i, 3)
End If
If IsNumeric(StockQueryForm.ListBox1.List(i, 5)) Then
value = CDbl(StockQueryForm.ListBox1.List(i, 5))
sum3 = sum3 + value
Else
' MsgBox "非数值数据: " &
StockQueryForm.ListBox1.List(i, 3)
End If
Next i
ListBox1.ForeColor = vbBlue
StockQueryForm.ListBox1.List(StockQueryForm.ListBox1.ListCount - 1, 3) = sum1
StockQueryForm.ListBox1.List(StockQueryForm.ListBox1.ListCount - 1, 4) = sum2
StockQueryForm.ListBox1.List(StockQueryForm.ListBox1.ListCount - 1, 5) = sum3
StockQueryForm.Label2 = "一共为您找到 " & rs.RecordCount & " 条记录！"
rs.Close
con.Close
Set rs = Nothing
Set con = Nothing
End Sub
2、Exit 退出按钮代码
Private Sub CommandButton2_Click()
Unload Me
End Sub
3、导出数据按钮代码
Private Sub CommandButton3_Click()
' 导出数据
Dim xlApp As Object, xlsheet As Object
Dim i As Integer, j As Integer
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If xlApp Is Nothing Then
Set xlApp = CreateObject("Excel.Application")
End If
On Error GoTo 0
xlApp.Workbooks.Add
' 设置引用Excel工作表
Set xlsheet = xlApp.Workbooks(2).Worksheets(1)
' 将ListBox中的数据导出到Excel
For i = 0 To ListBox1.ListCount - 1
For j = 0 To ListBox1.ColumnCount - 1
xlsheet.Cells(i + 1, j + 1).value = ListBox1.List(i, j)
Next j
Next i
xlsheet.columns.AutoFit
' 显示Excel
xlApp.Visible = True
Dim savePath As String
savePath = "D:\Rape" & Format(Date, "yyyymmdd") & ".xlsx" ' 请替换为你想保存的路径和文件名
ActiveWorkbook.SaveAs Filename:=savePath
MsgBox "Saved in D:/"
ActiveWorkbook.Close SaveChanges:=False
Set xlsheet = Nothing
Set xlApp = Nothing
End Sub
4、设置listbox
Private Sub ListBox1_Click()
Dim selectedIndex As Integer
Dim selectedText As String
' 获取选中的行的索引
selectedIndex = ListBox1.ListIndex
' 检查是否有行被选中
If selectedIndex <> -1 Then
' 获取选中行的文本
' selectedText = ListBox1.List(selectedIndex)
selectedText = ListBox1.List(selectedIndex)
' 可以在这里处理选中的行，例如显示在文本框中
StockQueryForm.Label3 = "您当前选择的是第 " & selectedIndex & " 条记录！" & selectedText
End If
End Sub
5、初始化窗体
Private Sub UserForm_Initialize()
Dim sh As Worksheet
Dim n As Integer
Dim arr()
Dim d As Object
Dim i As Integer
Set sh = Sheets("Package")
n = sh.Cells(Rows.Count, "A").End(xlUp).row
arr = sh.Range("C2:C" & n)
Set d = CreateObject("scripting.dictionary")
For i = 1 To UBound(arr)
d(arr(i, 1)) = ""
Next i
StockQueryForm.ComboBox1.List = d.keys
Erase arr()
Set sh = Nothing
Set d = Nothing
End Sub
以上代码修改文件路径后，直接粘贴可用。
其他代码下期分享。