MySQL, Oracle, Linux, 软件架构及大数据技术知识分享平台

网站首页 > 精选文章 / 正文

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

2025-03-07 19:28 huorong 精选文章 5 ℃ 0 评论

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

一、效果展示

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

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 (退出)按钮代码:


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

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

Tags:subcommand

控制面板
您好,欢迎到访网站!
  查看权限
网站分类
最新留言