Excel VBA 小白入门窗体应用之增删改查

欢迎大家来到IT世界,在知识的湖畔探索吧!

Excel VBA 在工作中应用来愈广泛，人们的需求越来越多样，今天笔者给大家带来ExcelVBA的别样应用。

一、效果展示

1、双击Excel文件，启动窗体，出现登陆界面

欢迎大家来到IT世界,在知识的湖畔探索吧!

2、输入用户名、密码，登陆主界面

3、主要功能-增删改查

插入信息

这里我们插入一条如下信息，点击Create

查询信息

我们看到刚才输入的一条信息：

删除信息

这里假设我们删除 id为 6 的信息：首先输入6，点击Query，确认无误后点击Delete。

修改信息

这里假设我们将id为5的信息修改为id为3。

首先输入5，点击查询

然后修改id 为3，点击Update:

删除信息：

这里我们删除第4条信息（id为5）：

所有信息

二、实现过程

1、插入登陆窗体

2、插入主界面窗体

3、插入入库管理窗体

4、插入出库查询窗体

三、完整代码

1、启动登陆窗体代码：

2、登陆窗体 Enter 按钮代码：

登陆信息保存位置：

Exit（退出）按钮代码：

3、主界面“入库管理”按钮代码：

入库管理界面

Create（插入信息）按钮代码：

Detete（删除信息）按钮代码：

Update（修改）按钮代码：

Query（查询）按钮代码：

Private Sub CommandButton4_Click()

Call CheckID

Dim cn As Object

Dim rs As Object

Dim strPath As String

Dim strConn As String

Dim strSQL As String

Dim n As Integer

Dim name As String

Dim id As String

Dim sh As Worksheet

Set sh = Sheets(1)

Set cn = CreateObject(“adodb.connection”)

strPath = ThisWorkbook.FullName

If Application.Version < 12 Then

strConn = “provider=Microsoft.jet.OLEDB.4.0;extended properties=’excel 8.0;hdr=yes;imex=1′;data source=” & strPath

Else

strConn = “provider=Microsoft.ACE.OLEDB.12.0;extended properties=’excel 12.0;hdr=yes;imex=1′;data source=” & strPath

End If

cn.Open strConn

If UserForm3.TextBox1.Text = “” Then MsgBox “ID Cannot blank”: Exit Sub

name = UserForm3.TextBox1.Text

strSQL = “select id,product,description,small_bag,qty,price,status from [sheet1$] where id = ” & name & “”

Set rs = cn.Execute(strSQL)

n = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1

If rs.EOF And rs.BOF Then

UserForm3.TextBox1.Text = “”

Else

Do While Not rs.EOF

With UserForm3

.TextBox1.Text = rs(0).Value

.TextBox2.Text = rs(1).Value

.TextBox3.Text = rs(2).Value

.TextBox4.Text = rs(3).Value

.TextBox5.Text = rs(4).Value

.TextBox6.Text = rs(5).Value

.TextBox7.Text = rs(6).Value

End With

rs.MoveNext

Loop

End If

rs.Close

cn.Close

Set rs = Nothing

Set cn = Nothing

Set sh = Nothing

End Sub

用来检查ID的代码：

Exit（退出）按钮代码：

4、主界面出库查询按钮代码：

出库查询界面

Query按钮代码：

Private Sub CommandButton1_Click()

Dim cn As Object

Dim rs As Object

Dim strPath As String

Dim strConn As String

Dim strSQL As String

Dim i As Integer

Dim name As String

Dim sh As Worksheet

Set sh = Sheets(1)

Set cn = CreateObject(“adodb.connection”)

strPath = ThisWorkbook.FullName

If Application.Version < 12 Then

strConn = “provider=Microsoft.jet.OLEDB.4.0;extended properties=’excel 8.0;hdr=yes;imex=1′;data source=” & strPath

Else

strConn = “provider=Microsoft.ACE.OLEDB.12.0;extended properties=’excel 12.0;hdr=yes;imex=1′;data source=” & strPath

End If

cn.Open strConn

name = TextBox1.Value

‘strSQL = “select name from [sheet1$] where name='” & name & “‘”

strSQL = “select id,product,description,IIF(small_bag=”,’-‘,small_bag)as small_bag,qty,price,price*qty as amount,status from [sheet1$] where status like ‘%” & name & “%'”

Set rs = cn.Execute(strSQL)

n = sh.Cells(Rows.Count, 1).End(xlUp).Row

If rs.EOF And rs.BOF Then

ListBox1.Clear

ListBox1.ColumnWidths = “50;60;80;50;50;50;60;50”

ListBox1.ColumnCount = 8

Else

ListBox1.Clear

ListBox1.ColumnWidths = “50;60;80;80;50;50;60;50”

ListBox1.ColumnCount = 8

ListBox1.Font.Size = 14

ListBox1.AddItem rs.Fields(0).name

ListBox1.List(ListBox1.ListCount – 1, 1) = rs.Fields(1).name

ListBox1.List(ListBox1.ListCount – 1, 2) = rs.Fields(2).name

ListBox1.List(ListBox1.ListCount – 1, 3) = rs.Fields(3).name

ListBox1.List(ListBox1.ListCount – 1, 4) = rs.Fields(4).name

ListBox1.List(ListBox1.ListCount – 1, 5) = rs.Fields(5).name

ListBox1.List(ListBox1.ListCount – 1, 6) = rs.Fields(6).name

ListBox1.List(ListBox1.ListCount – 1, 7) = rs.Fields(7).name

Do While Not rs.EOF

ListBox1.AddItem rs(0).Value

ListBox1.List(ListBox1.ListCount – 1, 1) = rs(1).Value

ListBox1.List(ListBox1.ListCount – 1, 2) = rs(2).Value

ListBox1.List(ListBox1.ListCount – 1, 3) = rs(3).Value

ListBox1.List(ListBox1.ListCount – 1, 4) = rs(4).Value

ListBox1.List(ListBox1.ListCount – 1, 5) = rs(5).Value

ListBox1.List(ListBox1.ListCount – 1, 6) = rs(6).Value

ListBox1.List(ListBox1.ListCount – 1, 7) = rs(7).Value

rs.MoveNext

Loop

End If

rs.Close

cn.Close

Set cn = Nothing

Set rs = Nothing

Set sh = Nothing

End Sub

Exit （退出）按钮代码：

到此为此，所有的代码已经贴出，其他没有展示的功能，如注册用户、修改密码等因没有展示效果，也不是很重要，这里就不贴代码了。

喜欢的朋友，欢迎点赞、评论、转发、关注、收藏，让更多的人受益。