【每日任务管理系统】(1) VB 管理系统 代码分享 Visual Basic 编程
前端程序开发平台为VB6.0，编程语言为Visual Basic
系统登录
Private Sub Command登录_Click()
Dim 账号text As String \’定义变量存储账号
Dim 密码text As String \’定义变量存储密码
If Trim(Me.Text账号) <> \”\” Then \’输入账号不能为空
账号text = Me.Text账号 \’存储录入账号到变量中（可拓展更多判断，如字符长度等）
Else
MsgBox \”账号不能为空！\”
Exit Sub
End If
If Trim(Me.Text密码) <> \”\” Then \’输入密码不能为空
If Len(Trim(Me.Text密码)) < 6 Then
MsgBox \”密码长度不能小于6位！\”
Exit Sub
End If
密码text = Me.Text密码 \’存储录入密码到变量中（可拓展更多判断，如字符长度等）
Else
MsgBox \”密码不能为空！\”
Exit Sub
End If
\’-账号密码验证
Dim login_conn As New ADODB.Connection \’连接到ACCESS数据库
With login_conn \’mdb格式连接
.ConnectionString = \”Provider = microsoft.jet.oledb.4.0;data source=\” & App.Path & \”\\db_rw.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false\”
.Open
End With
Dim login_rs As New ADODB.Recordset
Dim login_sql As String
login_sql = \”select * from 账号表 where 账号= \’\” & Me.Text账号 & \”\’ and 密码=\’\” & Me.Text密码 & \”\’\” \’查询用户表
login_rs.Open login_sql, login_conn, adOpenDynamic, adLockOptimistic
If login_rs.EOF = False Then \’循环表的内容
\’–
On Error Resume Next
login_name = login_rs.Fields(\”账号\”).Value \’账号密码赋值到公共变量之后使用
login_pw = login_rs.Fields(\”密码\”).Value
user_name = login_rs.Fields(\”姓名\”).Value
user_role = login_rs.Fields(\”角色\”).Value
全部任务权限 = login_rs.Fields(\”全部任务\”).Value
任务查看权限 = login_rs.Fields(\”任务查看\”).Value
任务添加权限 = login_rs.Fields(\”任务添加\”).Value
任务更新权限 = login_rs.Fields(\”任务更新\”).Value
任务删除权限 = login_rs.Fields(\”任务删除\”).Value
常见任务管理权限 = login_rs.Fields(\”常见任务管理\”).Value
负责人管理权限 = login_rs.Fields(\”负责人管理\”).Value
任务类型管理权限 = login_rs.Fields(\”任务类型管理\”).Value
任务状态管理权限 = login_rs.Fields(\”任务状态管理\”).Value
MsgBox \”登录成功\”, , \”提示\”
Unload Me \’关闭登录窗体
frm系统主页.Show
Else
MsgBox \”账号或密码错误，请重新登录\”
login_count = login_count + 1 \’登录错误3次，退出
If login_count = 3 Then
MsgBox \”账号或密码错误达3次\”
Unload Me
End If
End If
login_rs.Close
Set login_rs = Nothing
login_conn.Close
Set login_conn = Nothing
Exit Sub
登录失败错误:
MsgBox Err.Description
End Sub
Private Sub Command退出_Click()
Unload Me
End Sub
Private Sub Command用户注册_Click()
frm用户注册.Show 1
End Sub
系统主页
Private Sub cjrw_Click(Index As Integer)
If 常见任务管理权限 = False Then
MsgBox \”无权限\”
Exit Sub
End If
frm常见任务.Show 1
End Sub
Private Sub fhdl_Click()
Unload Me
frm系统登录.Show
login_name = \”\”
login_pw = \”\”
user_name = \”\”
user_role = \”\”
全部任务权限 = False
任务查看权限 = False
任务添加权限 = False
任务更新权限 = False
任务删除权限 = False
常见任务管理权限 = False
负责人管理权限 = False
任务类型管理权限 = False
任务状态管理权限 = False
End Sub
Private Sub Form_Load()
StatusBar1.Panels(2).Text = login_name
StatusBar1.Panels(3).Text = user_name
StatusBar1.Panels(4).Text = user_role
Label日期.Caption = Date
\’当前登录用户添加的任务
Adodc1.ConnectionString = \”Provider=Microsoft.Jet.OLEDB.4.0;Data Source=\” & App.Path & \”\\db_rw.mdb;Jet OLEDB:DataBase password=abc123;Persist Security Info=False\”
Adodc1.CommandType = adCmdUnknown
Adodc1.RecordSource = \”Select * From 今日任务查询 where \” & \”创建账号 =\’\” & login_name & \”\’\”
Adodc1.Refresh \’刷新
End Sub
Private Sub fzr_Click(Index As Integer)
If 负责人管理权限 = False Then
MsgBox \”无权限\”
Exit Sub
End If
frm负责人.Show 1
End Sub
Private Sub grxx_Click()
frm个人信息.Show 1
End Sub
Private Sub qbrw_Click(Index As Integer)
If 全部任务权限 = False Then
MsgBox \”无权限\”
Exit Sub
End If
frm全部任务.Show 1
End Sub
Private Sub rwcx_Click(Index As Integer)
If 任务查看权限 = False Then
MsgBox \”无权限\”
Exit Sub
End If
frm任务查询.Show 1
End Sub
Private Sub rwlx_Click(Index As Integer)
If 任务类型管理权限 = False Then
MsgBox \”无权限\”
Exit Sub
End If
frm任务类型.Show 1
End Sub
Private Sub rwtj_Click(Index As Integer)
If 任务添加权限 = False Then
MsgBox \”无权限\”
Exit Sub
End If
frm任务添加.Show 1
End Sub
Private Sub rwzt_Click(Index As Integer)
If 任务状态管理权限 = False Then
MsgBox \”无权限\”
Exit Sub
End If
frm任务状态.Show 1
End Sub
Private Sub tcxt_Click()
Unload Me
End Sub
Private Sub xgmm_Click()
frm修改密码.Show 1
End Sub
常见任务
Option Explicit
Public frm_title As String \’存储窗体标题
Public frm_datatype As Integer \’存储当前管理状态（添加，修改，查询）
Public key_data As String \’存储修改主键
Dim search_filter As String \’存储筛选条件
Dim search_order As String \’存储排序条件
Private Sub Command保存_Click()
On Error GoTo 保存失败错误
\’========================================================================为添加状态时
If frm_datatype = 1 Then
\’判断数据不能为空
If Text1(0).Text <> \”\” Then
\’满足条件添加记录
\’———————————-
Dim add_conn As New ADODB.Connection \’连接数据
Dim add_rs As New ADODB.Recordset
With add_conn
.ConnectionString = \”Provider = microsoft.jet.oledb.4.0;data source=\” & App.Path & \”\\db_rw.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false\”
.Open
End With
add_rs.Open \”常见任务表\”, add_conn, adOpenKeyset, adLockOptimistic \’连接表生成记录集
add_rs.AddNew \’添加记录
On Error Resume Next
add_rs!任务名称 = Text1(0).Text \’新记录赋值
add_rs.Update \’更新
add_rs.Close \’关闭清空记录集和连接
Set add_rs = Nothing
add_conn.Close
Set add_conn = Nothing
MsgBox \”添加完成\”
Text1(0).Text = \”\”
Adodc1.Refresh \’刷新显示结果
DataGrid1.Refresh
Text1(0).SetFocus \’第一个录入数据控件获得焦点继续录入
\’———————————-
Else
MsgBox \”任务名称不能为空\”
Exit Sub
End If
End If
\’========================================================================为修改状态时
If frm_datatype = 2 Then
\’判断数据不能为空
If Text1(0).Text <> \”\” Then
\’判断主键不能重复
If key_data <> Text1(0).Text Then \’主键修改，判断主键是否重复
If dcountlink(\”任务名称\”, \”常见任务表\”, \”任务名称=\’\” & Text1(0) & \”\’\”, 0) > 0 Then
MsgBox \”该任务名称已存在，请修改后重试\”
Exit Sub
End If
End If
\’满足条件添加记录
\’———————————-
\’连接数据库并更新
Dim update_conn As New ADODB.Connection
Dim update_rs As New ADODB.Recordset
With update_conn
.ConnectionString = \”Provider = microsoft.jet.oledb.4.0;data source=\” & App.Path & \”\\db_rw.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false\”
.Open
End With
Dim update_sql As String
update_sql = \”Select * From 常见任务表 Where 任务名称=\’\” & key_data & \”\’\”
update_rs.Open update_sql, update_conn, adOpenKeyset, adLockOptimistic
\’–字段更新
On Error Resume Next
With update_rs
!任务名称 = Text1(0).Text \’新记录赋值
End With
update_rs.Update
update_rs.Close
Set update_rs = Nothing
update_conn.Close
Set update_conn = Nothing
key_data = Text1(0) \’主键赋值
MsgBox \”更新完成！\”
Adodc1.Refresh \’刷新显示结果
DataGrid1.Refresh
Text1(0).SetFocus \’第一个录入数据控件获得焦点
\’———————————-
Else
MsgBox \”任务名称不能为空\”
Exit Sub
End If
End If
Exit Sub
保存失败错误:
MsgBox Err.Description
End Sub
Private Sub Command取消_Click()
frm_datatype = 5
Call changetitle(frm_datatype)
Dim i \’清空控件中的数据
For i = 1 To Text1.Count
Text1(i – 1).Text = \”\”
Next i
\’点击取消时显示全部记录，清空条件
search_filter = \”\”
Adodc1.Refresh
DataGrid1.Refresh
End Sub
Private Sub Command删除_Click()
On Error GoTo 删除失败错误
Dim del_data As String
del_data = DataGrid1.Columns(0).Text
If MsgBox(\”是否删除任务名称为【\” & del_data & \”】 的记录？\”, vbYesNo, \”提示\”) <> vbYes Then \’删除前提醒
Exit Sub
End If
\’执行删除操作
Dim del_conn As New ADODB.Connection
Dim del_sql As String
del_sql = \”delete from 常见任务表 Where 任务名称=\’\” & del_data & \”\’\” \’定义删除sql语句
With del_conn
.ConnectionString = \”Provider = microsoft.jet.oledb.4.0;data source=\” & App.Path & \”\\db_rw.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false\”
.Open
.Execute del_sql \’执行删除
End With
del_conn.Close
Set del_conn = Nothing
MsgBox \”删除成功\”
Adodc1.Refresh \’刷新显示结果
DataGrid1.Refresh
Exit Sub
删除失败错误:
MsgBox Err.Description
End Sub
Private Sub Command添加_Click()
frm_datatype = 1
Call changetitle(frm_datatype)
Dim i
For i = 1 To Text1.Count \’控件取消锁定可录入数据
Text1(i – 1).Text = \”\”
Text1(i – 1).Locked = False
Next i
Text1(0).Locked = False
Text1(0).SetFocus \’第一个控件获得焦点
End Sub
Private Sub Command修改_Click()
key_data = 0
frm_datatype = 2
Call changetitle(frm_datatype)
End Sub
Private Sub DataGrid1_DblClick()
If frm_datatype <> 2 Then \’判断是否为修改状态
MsgBox \”需要修改数据，请先进入修改状态\”
Exit Sub
End If
Dim i
For i = 0 To Text1.UBound \’获取选择记录的数据
Text1(i).Text = DataGrid1.Columns(i).Text
Next i
\’解除锁定（数据可编辑）
For i = 0 To Text1.UBound
Text1(i).Locked = False
Next i
Text1(0).Locked = False
Text1(0).SetFocus
key_data = Text1(0).Text \’主键赋值
End Sub
Private Sub Form_Load() \’窗体加载
frm_title = \”常见任务管理\” \’赋值标题到变量
frm_datatype = 5 \’设置窗体当前管理数据类型
Call changetitle(frm_datatype)
Dim i
For i = 1 To Text1.Count \’控件锁定不可录入数据
Text1(i – 1).Text = \”\”
Text1(i – 1).Locked = True
Next i
Adodc1.Refresh \’刷新
End Sub
Private Sub Text1_GotFocus(Index As Integer) \’文本框获得焦点，背景色修改，选中原有文本
Text1(Index).BackColor = &HFFFF00
Text1(Index).SelStart = 0
Text1(Index).SelLength = Len(Text1(Index))
End Sub
Private Sub Text1_LostFocus(Index As Integer) \’文本框失去焦点设计填充颜色（恢复）
Text1(Index).BackColor = &H80000005
End Sub
Sub changetitle(ByVal frmdatatype As Integer) \’根据状态显示不同标题，设置按钮状态
Select Case frmdatatype
Case 1 \’添加
Me.Caption = frm_title & \”（添加）\”
\’按钮状态设置
Me.Command添加.Enabled = False
Me.Command修改.Enabled = False
Me.Command保存.Enabled = True
Me.Command取消.Enabled = True
Me.Command删除.Enabled = False
Case 2 \’添加
Me.Caption = frm_title & \”（修改）\”
\’按钮状态设置
Me.Command添加.Enabled = False
Me.Command修改.Enabled = False
Me.Command保存.Enabled = True
Me.Command取消.Enabled = True
Me.Command删除.Enabled = False
Case 3 \’删除
Me.Caption = frm_title
Case 5 \’取消
Me.Caption = frm_title
\’按钮状态设置
Me.Command添加.Enabled = True
Me.Command修改.Enabled = True
Me.Command保存.Enabled = False
Me.Command取消.Enabled = True
Me.Command删除.Enabled = True
key_data = 0
\’锁定所有控件
Dim i
For i = 0 To Text1.UBound
Text1(i).Locked = True
Next i
Case Else
Me.Caption = frm_title
\’按钮状态设置
Me.Command添加.Enabled = False
Me.Command修改.Enabled = False
Me.Command保存.Enabled = False
Me.Command取消.Enabled = False
Me.Command删除.Enabled = False
End Select
End Sub
常见任务选择
Private Sub Command查询_Click()
If Text(0).Text <> \”\” Then
Adodc1.RecordSource = \”Select * From 常见任务表 where 任务名称 like \’%\” & Text(0).Text & \”%\’\”
Else
Adodc1.RecordSource = \”Select * From 常见任务表\”
End If
Adodc1.Refresh
DataGrid1.Refresh
DataGrid1.SetFocus
End Sub
Private Sub Command全部_Click()
Adodc1.RecordSource = \”Select * From 常见任务表\”
Adodc1.Refresh
DataGrid1.Refresh
DataGrid1.SetFocus
End Sub
Private Sub Command选择_Click()
On Error Resume Next
Dim i
For i = 0 To Forms.Count – 1
If Forms(i).Name = rw_formname Then
Forms(i).Text(0) = DataGrid1.Columns(0).Text
End If
Next i
Unload Me
End Sub
Private Sub Form_Load()
Adodc1.CommandType = adCmdUnknown
End Sub
负责人
Public frm_title As String \’存储窗体标题
Public frm_datatype As Integer \’存储当前管理状态（添加，修改，查询）
Public key_data As String \’存储修改主键
Dim search_filter As String \’存储筛选条件
Dim search_order As String \’存储排序条件
Private Sub Command保存_Click()
On Error GoTo 保存失败错误
\’==为添加状态时
If frm_datatype = 1 Then
\’判断数据不能为空
If Text1(0).Text <> \”\” Then
\’满足条件添加记录
\’———————————-
Dim add_conn As New ADODB.Connection \’连接数据
Dim add_rs As New ADODB.Recordset
With add_conn
.ConnectionString = \”Provider = microsoft.jet.oledb.4.0;data source=\” & App.Path & \”\\db_rw.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false\”
.Open
End With
add_rs.Open \”负责人表\”, add_conn, adOpenKeyset, adLockOptimistic \’连接表生成记录集
add_rs.AddNew \’添加记录
On Error Resume Next
add_rs!负责人 = Text1(0).Text \’新记录赋值
add_rs.Update \’更新
add_rs.Close \’关闭清空记录集和连接
Set add_rs = Nothing
add_conn.Close
Set add_conn = Nothing
MsgBox \”添加完成\”
Text1(0).Text = \”\”
Adodc1.Refresh \’刷新显示结果
DataGrid1.Refresh
Text1(0).SetFocus \’第一个录入数据控件获得焦点继续录入
\’———————————-
Else
MsgBox \”负责人不能为空\”
Exit Sub
End If
End If
\’========================================================================为修改状态时
If frm_datatype = 2 Then
\’判断数据不能为空
If Text1(0).Text <> \”\” Then
\’判断主键不能重复
If key_data <> Text1(0).Text Then \’主键修改，判断主键是否重复
If dcountlink(\”负责人\”, \”负责人表\”, \”负责人=\’\” & Text1(0) & \”\’\”, 0) > 0 Then
MsgBox \”该负责人已存在，请修改后重试\”
Exit Sub
End If
End If
\’满足条件添加记录
\’———————————-
\’连接数据库并更新
Dim update_conn As New ADODB.Connection
Dim update_rs As New ADODB.Recordset
With update_conn
.ConnectionString = \”Provider = microsoft.jet.oledb.4.0;data source=\” & App.Path & \”\\db_rw.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false\”
.Open
End With
Dim update_sql As String
update_sql = \”Select * From 负责人表 Where 负责人=\’\” & key_data & \”\’\”
update_rs.Open update_sql, update_conn, adOpenKeyset, adLockOptimistic
\’–字段更新
On Error Resume Next
With update_rs
!负责人 = Text1(0).Text \’新记录赋值
End With
update_rs.Update
update_rs.Close
Set update_rs = Nothing
update_conn.Close
Set update_conn = Nothing
key_data = Text1(0) \’主键赋值
MsgBox \”更新完成！\”
Adodc1.Refresh \’刷新显示结果
DataGrid1.Refresh
Text1(0).SetFocus \’第一个录入数据控件获得焦点
\’———————————-
Else
MsgBox \”负责人不能为空\”
Exit Sub
End If
End If
Exit Sub
保存失败错误:
MsgBox Err.Description
End Sub
Private Sub Command取消_Click()
frm_datatype = 5
Call changetitle(frm_datatype)
Dim i \’清空控件中的数据
For i = 1 To Text1.Count
Text1(i – 1).Text = \”\”
Next i
\’点击取消时显示全部记录，清空条件
search_filter = \”\”
Adodc1.Refresh
DataGrid1.Refresh
End Sub
Private Sub Command删除_Click()
On Error GoTo 删除失败错误
Dim del_data As String
del_data = DataGrid1.Columns(0).Text
If MsgBox(\”是否删除负责人为【\” & del_data & \”】 的记录？\”, vbYesNo, \”提示\”) <> vbYes Then \’删除前提醒
Exit Sub
End If
\’执行删除操作
Dim del_conn As New ADODB.Connection
Dim del_sql As String
del_sql = \”delete from 负责人表 Where 负责人=\’\” & del_data & \”\’\” \’定义删除sql语句
With del_conn
.ConnectionString = \”Provider = microsoft.jet.oledb.4.0;data source=\” & App.Path & \”\\db_rw.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false\”
.Open
.Execute del_sql \’执行删除
End With
del_conn.Close
Set del_conn = Nothing
MsgBox \”删除成功\”
Adodc1.Refresh \’刷新显示结果
DataGrid1.Refresh
Exit Sub
删除失败错误:
MsgBox Err.Description
End Sub
Private Sub Command添加_Click()
frm_datatype = 1
Call changetitle(frm_datatype)
Dim i
For i = 1 To Text1.Count \’控件取消锁定可录入数据
Text1(i – 1).Text = \”\”
Text1(i – 1).Locked = False
Next i
Text1(0).Locked = False
Text1(0).SetFocus \’第一个控件获得焦点
End Sub
Private Sub Command修改_Click()
key_data = 0
frm_datatype = 2
Call changetitle(frm_datatype)
End Sub
Private Sub DataGrid1_DblClick()
If frm_datatype <> 2 Then \’判断是否为修改状态
MsgBox \”需要修改数据，请先进入修改状态\”
Exit Sub
End If
Dim i
For i = 0 To Text1.UBound \’获取选择记录的数据
Text1(i).Text = DataGrid1.Columns(i).Text
Next i
\’解除锁定（数据可编辑）
For i = 0 To Text1.UBound
Text1(i).Locked = False
Next i
Text1(0).Locked = False
Text1(0).SetFocus
key_data = Text1(0).Text \’主键赋值
End Sub
Private Sub Form_Load() \’窗体加载
frm_title = \”负责人管理\” \’赋值标题到变量
frm_datatype = 5 \’设置窗体当前管理数据类型
Call changetitle(frm_datatype)
Dim i
For i = 1 To Text1.Count \’控件锁定不可录入数据
Text1(i – 1).Text = \”\”
Text1(i – 1).Locked = True
Next i
Adodc1.Refresh \’刷新
End Sub
Private Sub Text1_GotFocus(Index As Integer) \’文本框获得焦点，背景色修改，选中原有文本
Text1(Index).BackColor = &HFFFF00
Text1(Index).SelStart = 0
Text1(Index).SelLength = Len(Text1(Index))
End Sub
Private Sub Text1_LostFocus(Index As Integer) \’文本框失去焦点设计填充颜色（恢复）
Text1(Index).BackColor = &H80000005
End Sub
Sub changetitle(ByVal frmdatatype As Integer) \’根据状态显示不同标题，设置按钮状态
Select Case frmdatatype
Case 1 \’添加
Me.Caption = frm_title & \”（添加）\”
\’按钮状态设置
Me.Command添加.Enabled = False
Me.Command修改.Enabled = False
Me.Command保存.Enabled = True
Me.Command取消.Enabled = True
Me.Command删除.Enabled = False
Case 2 \’添加
Me.Caption = frm_title & \”（修改）\”
\’按钮状态设置
Me.Command添加.Enabled = False
Me.Command修改.Enabled = False
Me.Command保存.Enabled = True
Me.Command取消.Enabled = True
Me.Command删除.Enabled = False
Case 3 \’删除
Me.Caption = frm_title
Case 5 \’取消
Me.Caption = frm_title
\’按钮状态设置
Me.Command添加.Enabled = True
Me.Command修改.Enabled = True
Me.Command保存.Enabled = False
Me.Command取消.Enabled = True
Me.Command删除.Enabled = True
key_data = 0
\’锁定所有控件
Dim i
For i = 0 To Text1.UBound
Text1(i).Locked = True
Next i
Case Else
Me.Caption = frm_title
\’按钮状态设置
Me.Command添加.Enabled = False
Me.Command修改.Enabled = False
Me.Command保存.Enabled = False
Me.Command取消.Enabled = False
Me.Command删除.Enabled = False
End Select
End Sub
个人信息
Private Sub Command保存_Click()
If Me.Text1(2).Text <> \”\” Then
If Me.Text1(2).Text <> \”男\” And Me.Text1(2).Text <> \”女\” Then
MsgBox \”性别只能输入男或女\”
Exit Sub
End If
End If
If MsgBox(\”是否更新个人信息？\”, vbYesNo, \”提示\”) = vbYes Then
Me.Adodc1.Recordset.Update
MsgBox \”更新完成\”
End If
End Sub
Private Sub Form_Load()
Me.Adodc1.ConnectionString = \”Provider=Microsoft.Jet.OLEDB.4.0;Data Source=\” & App.Path & \”\\db_rw.mdb;Jet OLEDB:DataBase password=abc123;Persist Security Info=False\”
Me.Adodc1.CommandType = adCmdUnknown
Me.Adodc1.RecordSource = \”select * From 账号表 Where 账号=\’\” & login_name & \”\’\”
Me.Adodc1.Refresh \’刷新
\’显示权限
Check全部任务.Value = CInt(Adodc1.Recordset.Fields(\”全部任务\”).Value) * -1
Check任务查看.Value = CInt(Adodc1.Recordset.Fields(\”任务查看\”).Value) * -1
Check任务添加.Value = CInt(Adodc1.Recordset.Fields(\”任务添加\”).Value) * -1
Check任务更新.Value = CInt(Adodc1.Recordset.Fields(\”任务更新\”).Value) * -1
Check任务删除.Value = CInt(Adodc1.Recordset.Fields(\”任务删除\”).Value) * -1
Check常见任务管理.Value = CInt(Adodc1.Recordset.Fields(\”常见任务管理\”).Value) * -1
Check负责人管理.Value = CInt(Adodc1.Recordset.Fields(\”负责人管理\”).Value) * -1
Check任务类型管理.Value = CInt(Adodc1.Recordset.Fields(\”任务类型管理\”).Value) * -1
Check任务状态管理.Value = CInt(Adodc1.Recordset.Fields(\”任务状态管理\”).Value) * -1
End Sub
修改密码
Private Sub Command修改密码_Click()
On Error GoTo 操作失败错误
Dim lname As String
Dim opw As String
Dim npw As String
If Trim(Me.Text账号) <> \”\” Then \’判断账号不能为空
lname = Trim(Me.Text账号)
Else
MsgBox \”账号不能为空\”
Exit Sub
End If
If Trim(Me.Textoldpw) <> \”\” Then \’判断旧密码不能为空
opw = Trim(Me.Textoldpw)
Else
MsgBox \”原密码不能为空\”
Exit Sub
End If
If Trim(Me.Textnewpw) <> \”\” Then \’判断新密码不能为空
npw = Trim(Me.Textnewpw)
Else
MsgBox \”新密码不能为空\”
Exit Sub
End If
If opw <> login_pw Then \’判断原密码是否正确
MsgBox \”原密码不正确\”
Exit Sub
End If
If Len(Trim(Me.Textnewpw)) < 6 Then \’判断密码长度不能小于6
MsgBox \”密码长度不能小于6位！\”
Exit Sub
End If
If opw = npw Then \’新旧密码不能相同
MsgBox \”新密码不能与原密码相同\”
Exit Sub
End If
\’修改密码操作
Dim Cnn As New ADODB.Connection
Dim rs As New ADODB.Recordset
With Cnn \’mdb格式连接
.ConnectionString = \”Provider = microsoft.jet.oledb.4.0;data source=\” & App.Path & \”\\db_rw.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false\”
.Open
End With
Dim rs_sql As String
rs_sql = \”select * from 账号表 where 账号=\’\” & login_name & \”\’\” \’查询该账号记录
rs.Open rs_sql, Cnn, adOpenDynamic, adLockOptimistic
If rs.EOF = False Then \’循环表的内容
rs.Fields(\”密码\”) = npw
rs.Update
login_pw = npw
MsgBox \”修改密码完成\”
Else
MsgBox \”未找到该账号\”
Exit Sub
End If
rs.Close
Set rs = Nothing
Cnn.Close
Set Cnn = Nothing
Exit Sub
操作失败错误:
MsgBox Err.Description
End Sub
Private Sub Form_Load()
Me.Text账号 = login_name \’显示账号
End Sub
用户注册
Private Sub Command注册_Click()
On Error GoTo 错误提示
If Text1(0) = \”\” Or IsNull(Text1(0)) = True Then
MsgBox \”账号值不能为空！\”
Exit Sub
Else
If Len(Text1(0)) > 15 Then
MsgBox \”账号不能超过15个字符！\”
Exit Sub
End If
End If
If Text1(1) = \”\” Or IsNull(Text1(1)) = True Then
MsgBox \”姓名值不能为空！\”
Exit Sub
Else
If Len(Text1(1)) > 30 Then
MsgBox \”姓名不能超过30个字符！\”
Exit Sub
End If
End If
If Text1(2) = \”\” Or IsNull(Text1(2)) = True Then
MsgBox \”性别值不能为空！\”
Exit Sub
Else
End If
If Text1(3) = \”\” Or IsNull(Text1(3)) = True Then
MsgBox \”联系方式不能为空！\”
Exit Sub
Else
If Len(Text1(3)) > 30 Then
MsgBox \”联系方式不能超过30个字符！\”
Exit Sub
End If
End If
If Text1(4) = \”\” Or IsNull(Text1(4)) = True Then
MsgBox \”角色不能为空！\”
Exit Sub
Else
End If
If Text1(5) = \”\” Or IsNull(Text1(5)) = True Then
MsgBox \”密码不能为空！\”
Exit Sub
Else
If Len(Text1(5)) > 15 Then
MsgBox \”密码不能超过15个字符！\”
Exit Sub
End If
End If
If Text1(6) = \”\” Or IsNull(Text1(6)) = True Then
MsgBox \”确认密码不能为空！\”
Exit Sub
Else
End If
If Text1(5).Text <> Text1(6).Text Then
MsgBox \”密码和确认密码不一致！\”
Exit Sub
End If
\’检查账号是否已存在
If dcountlink(\”账号\”, \”账号表\”, \”账号=\’\” & Text1(1) & \”\’\”, 0) > 0 Then
MsgBox \”该账号已存在，请修改后重试\”
Exit Sub
End If
Dim add_conn As New ADODB.Connection
Dim add_rs As New ADODB.Recordset
With add_conn
.ConnectionString = \”Provider = microsoft.jet.oledb.4.0;data source=\” & App.Path & \”\\db_rw.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false\”
.Open
End With
add_rs.Open \”账号表\”, add_conn, adOpenKeyset, adLockOptimistic
add_rs.AddNew
On Error Resume Next
add_rs!账号.Value = Text1(0).Text
add_rs!姓名.Value = Text1(1).Text
add_rs!性别.Value = Text1(2).Text
add_rs!联系方式.Value = Text1(3).Text
add_rs!角色.Value = Text1(4).Text
add_rs!密码.Value = Text1(5).Text
add_rs!全部任务.Value = False
add_rs!任务查看.Value = True
add_rs!任务添加.Value = True
add_rs!任务更新.Value = True
add_rs!任务删除.Value = True
add_rs!常见任务管理.Value = False
add_rs!负责人管理.Value = False
add_rs!任务类型管理.Value = False
add_rs!任务状态管理.Value = False
add_rs.Update
add_rs.Close
Set add_rs = Nothing
add_conn.Close
Set add_conn = Nothing
MsgBox \”注册完成\”
Unload Me
Exit Sub
错误提示:
MsgBox Err.Description
End Sub
Private Sub Text1_DblClick(Index As Integer)
If Index = 2 Then
If Text1(2).Text = \”男\” Then
Text1(2).Text = \”女\”
Else
Text1(2).Text = \”男\”
End If
End If
End Sub
Private Sub Text1_LostFocus(Index As Integer)
If Text1(2).Text <> \”男\” And Text1(2).Text <> \”女\” Then
MsgBox \”性别只能输入男或女\”
Text1(2).Text = \”男\”
End If
End Sub
任务类型
Private Sub Command添加_Click()
frm_datatype = 1
Call changetitle(frm_datatype)
Dim i
For i = 1 To Text1.Count \’控件取消锁定可录入数据
Text1(i – 1).Text = \”\”
Text1(i – 1).Locked = False
Next i
Text1(0).Locked = False
Text1(0).SetFocus \’第一个控件获得焦点
End Sub
Private Sub Command修改_Click()
key_data = 0
frm_datatype = 2
Call changetitle(frm_datatype)
End Sub
Private Sub DataGrid1_DblClick()
If frm_datatype <> 2 Then \’判断是否为修改状态
MsgBox \”需要修改数据，请先进入修改状态\”
Exit Sub
End If
Dim i
For i = 0 To Text1.UBound \’获取选择记录的数据
Text1(i).Text = DataGrid1.Columns(i).Text
Next i
\’解除锁定（数据可编辑）
For i = 0 To Text1.UBound
Text1(i).Locked = False
Next i
Text1(0).Locked = False
Text1(0).SetFocus
key_data = Text1(0).Text \’主键赋值
End Sub
Private Sub Form_Load() \’窗体加载
frm_title = \”任务类型管理\” \’赋值标题到变量
frm_datatype = 5 \’设置窗体当前管理数据类型
Call changetitle(frm_datatype)
Dim i
For i = 1 To Text1.Count \’控件锁定不可录入数据
Text1(i – 1).Text = \”\”
Text1(i – 1).Locked = True
Next i
Adodc1.Refresh \’刷新
End Sub
Private Sub Text1_GotFocus(Index As Integer) \’文本框获得焦点，背景色修改，选中原有文本
Text1(Index).BackColor = &HFFFF00
Text1(Index).SelStart = 0
Text1(Index).SelLength = Len(Text1(Index))
End Sub
Private Sub Text1_LostFocus(Index As Integer) \’文本框失去焦点设计填充颜色（恢复）
Text1(Index).BackColor = &H80000005
End Sub
Sub changetitle(ByVal frmdatatype As Integer) \’根据状态显示不同标题，设置按钮状态
Select Case frmdatatype
Case 1 \’添加
Me.Caption = frm_title & \”（添加）\”
\’按钮状态设置
Me.Command添加.Enabled = False
Me.Command修改.Enabled = False
Me.Command保存.Enabled = True
Me.Command取消.Enabled = True
Me.Command删除.Enabled = False
Case 2 \’添加
Me.Caption = frm_title & \”（修改）\”
\’按钮状态设置
Me.Command添加.Enabled = False
Me.Command修改.Enabled = False
Me.Command保存.Enabled = True
Me.Command取消.Enabled = True
Me.Command删除.Enabled = False
Case 3 \’删除
Me.Caption = frm_title
Case 5 \’取消
Me.Caption = frm_title
\’按钮状态设置
Me.Command添加.Enabled = True
Me.Command修改.Enabled = True
Me.Command保存.Enabled = False
Me.Command取消.Enabled = True
Me.Command删除.Enabled = True
key_data = 0
\’锁定所有控件
Dim i
For i = 0 To Text1.UBound
Text1(i).Locked = True
Next i
Case Else
Me.Caption = frm_title
\’按钮状态设置
Me.Command添加.Enabled = False
Me.Command修改.Enabled = False
Me.Command保存.Enabled = False
Me.Command取消.Enabled = False
Me.Command删除.Enabled = False
End Select
End Sub
任务状态
Public frm_title As String \’存储窗体标题
Public frm_datatype As Integer \’存储当前管理状态（添加，修改，查询）
Public key_data As String \’存储修改主键
Dim search_filter As String \’存储筛选条件
Dim search_order As String \’存储排序条件
Private Sub Command保存_Click()
On Error GoTo 保存失败错误
\’========================================================================为添加状态时
If frm_datatype = 1 Then
\’判断数据不能为空
If Text1(0).Text <> \”\” Then
\’满足条件添加记录
\’———————————-
Dim add_conn As New ADODB.Connection \’连接数据
Dim add_rs As New ADODB.Recordset
With add_conn
.ConnectionString = \”Provider = microsoft.jet.oledb.4.0;data source=\” & App.Path & \”\\db_rw.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false\”
.Open
End With
add_rs.Open \”任务状态表\”, add_conn, adOpenKeyset, adLockOptimistic \’连接表生成记录集
add_rs.AddNew \’添加记录
On Error Resume Next
add_rs!任务状态 = Text1(0).Text \’新记录赋值
add_rs.Update \’更新
add_rs.Close \’关闭清空记录集和连接
Set add_rs = Nothing
add_conn.Close
Set add_conn = Nothing
MsgBox \”添加完成\”
Text1(0).Text = \”\”
Adodc1.Refresh \’刷新显示结果
DataGrid1.Refresh
Text1(0).SetFocus \’第一个录入数据控件获得焦点继续录入
\’———————————-
Else
MsgBox \”任务状态不能为空\”
Exit Sub
End If
End If
\’========================================================================为修改状态时
If frm_datatype = 2 Then
\’判断数据不能为空
If Text1(0).Text <> \”\” Then
\’判断主键不能重复
If key_data <> Text1(0).Text Then \’主键修改，判断主键是否重复
If dcountlink(\”任务状态\”, \”任务状态表\”, \”任务状态=\’\” & Text1(0) & \”\’\”, 0) > 0 Then
MsgBox \”该任务状态已存在，请修改后重试\”
Exit Sub
End If
End If
\’满足条件添加记录
\’———————————-
\’连接数据库并更新
Dim update_conn As New ADODB.Connection
Dim update_rs As New ADODB.Recordset
With update_conn
.ConnectionString = \”Provider = microsoft.jet.oledb.4.0;data source=\” & App.Path & \”\\db_rw.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false\”
.Open
End With
Dim update_sql As String
update_sql = \”Select * From 任务状态表 Where 任务状态=\’\” & key_data & \”\’\”
update_rs.Open update_sql, update_conn, adOpenKeyset, adLockOptimistic
\’–字段更新
On Error Resume Next
With update_rs
!任务状态 = Text1(0).Text \’新记录赋值
End With
update_rs.Update
update_rs.Close
Set update_rs = Nothing
update_conn.Close
Set update_conn = Nothing
key_data = Text1(0) \’主键赋值
MsgBox \”更新完成！\”
Adodc1.Refresh \’刷新显示结果
DataGrid1.Refresh
Text1(0).SetFocus \’第一个录入数据控件获得焦点
\’———————————-
Else
MsgBox \”任务状态不能为空\”
Exit Sub
End If
End If
Exit Sub
保存失败错误:
MsgBox Err.Description
End Sub
Private Sub Command取消_Click()
frm_datatype = 5
Call changetitle(frm_datatype)
Dim i \’清空控件中的数据
For i = 1 To Text1.Count
Text1(i – 1).Text = \”\”
Next i
\’点击取消时显示全部记录，清空条件
search_filter = \”\”
Adodc1.Refresh
DataGrid1.Refresh
End Sub
Private Sub Command删除_Click()
On Error GoTo 删除失败错误
Dim del_data As String
del_data = DataGrid1.Columns(0).Text
If MsgBox(\”是否删除任务状态为【\” & del_data & \”】 的记录？\”, vbYesNo, \”提示\”) <> vbYes Then \’删除前提醒
Exit Sub
End If
\’执行删除操作
Dim del_conn As New ADODB.Connection
Dim del_sql As String
del_sql = \”delete from 任务状态表 Where 任务状态=\’\” & del_data & \”\’\” \’定义删除sql语句
With del_conn
.ConnectionString = \”Provider = microsoft.jet.oledb.4.0;data source=\” & App.Path & \”\\db_rw.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false\”
.Open
.Execute del_sql \’执行删除
End With
del_conn.Close
Set del_conn = Nothing
MsgBox \”删除成功\”
Adodc1.Refresh \’刷新显示结果
DataGrid1.Refresh
Exit Sub
删除失败错误:
MsgBox Err.Description
End Sub
Private Sub Command添加_Click()
frm_datatype = 1
Call changetitle(frm_datatype)
Dim i
For i = 1 To Text1.Count \’控件取消锁定可录入数据
Text1(i – 1).Text = \”\”
Text1(i – 1).Locked = False
Next i
Text1(0).Locked = False
Text1(0).SetFocus \’第一个控件获得焦点
End Sub
Private Sub Command修改_Click()
key_data = 0
frm_datatype = 2
Call changetitle(frm_datatype)
End Sub
Private Sub DataGrid1_DblClick()
If frm_datatype <> 2 Then \’判断是否为修改状态
MsgBox \”需要修改数据，请先进入修改状态\”
Exit Sub
End If
Dim i
For i = 0 To Text1.UBound \’获取选择记录的数据
Text1(i).Text = DataGrid1.Columns(i).Text
Next i
\’解除锁定（数据可编辑）
For i = 0 To Text1.UBound
Text1(i).Locked = False
Next i
Text1(0).Locked = False
Text1(0).SetFocus
key_data = Text1(0).Text \’主键赋值
End Sub
Private Sub Form_Load() \’窗体加载
frm_title = \”任务状态管理\” \’赋值标题到变量
frm_datatype = 5 \’设置窗体当前管理数据类型
Call changetitle(frm_datatype)
Dim i
For i = 1 To Text1.Count \’控件锁定不可录入数据
Text1(i – 1).Text = \”\”
Text1(i – 1).Locked = True
Next i
Adodc1.Refresh \’刷新
End Sub
Private Sub Text1_GotFocus(Index As Integer) \’文本框获得焦点，背景色修改，选中原有文本
Text1(Index).BackColor = &HFFFF00
Text1(Index).SelStart = 0
Text1(Index).SelLength = Len(Text1(Index))
End Sub
Private Sub Text1_LostFocus(Index As Integer) \’文本框失去焦点设计填充颜色（恢复）
Text1(Index).BackColor = &H80000005
End Sub
Sub changetitle(ByVal frmdatatype As Integer) \’根据状态显示不同标题，设置按钮状态
Select Case frmdatatype
Case 1 \’添加
Me.Caption = frm_title & \”（添加）\”
\’按钮状态设置
Me.Command添加.Enabled = False
Me.Command修改.Enabled = False
Me.Command保存.Enabled = True
Me.Command取消.Enabled = True
Me.Command删除.Enabled = False
Case 2 \’添加
Me.Caption = frm_title & \”（修改）\”
\’按钮状态设置
Me.Command添加.Enabled = False
Me.Command修改.Enabled = False
Me.Command保存.Enabled = True
Me.Command取消.Enabled = True
Me.Command删除.Enabled = False
Case 3 \’删除
Me.Caption = frm_title
Case 5 \’取消
Me.Caption = frm_title
\’按钮状态设置
Me.Command添加.Enabled = True
Me.Command修改.Enabled = True
Me.Command保存.Enabled = False
Me.Command取消.Enabled = True
Me.Command删除.Enabled = True
key_data = 0
\’锁定所有控件
Dim i
For i = 0 To Text1.UBound
Text1(i).Locked = True
Next i
Case Else
Me.Caption = frm_title
\’按钮状态设置
Me.Command添加.Enabled = False
Me.Command修改.Enabled = False
Me.Command保存.Enabled = False
Me.Command取消.Enabled = False
Me.Command删除.Enabled = False
End Select
End Sub
公共变量
Public login_name As String \’账号
Public login_pw As String \’密码
Public user_name As String \’姓名
Public user_role As String \’角色
\’权限
Public 全部任务权限 As Boolean
Public 任务查看权限 As Boolean
Public 任务添加权限 As Boolean
Public 任务更新权限 As Boolean
Public 任务删除权限 As Boolean
Public 常见任务管理权限 As Boolean
Public 负责人管理权限 As Boolean
Public 任务类型管理权限 As Boolean
Public 任务状态管理权限 As Boolean
\’——————————————-
\’任务
Public rw_filter As String \’筛选
Public rw_order As String \’排序
Public rw_num As Long \’主键
Public rw_formname As String \’任务选择
公共函数过程
Public Function dlookuplink(ByVal rsfieldname As String, ByVal rstable As String, ByVal rscondition As String, ByVal nullvalue) As String \’查询指定记录返回值
Dim dlookuplink_conn As New ADODB.Connection
Dim dlookuplink_rs As New ADODB.Recordset
dlookuplink = nullvalue
On Error GoTo 查找记录出错
With dlookuplink_conn
.ConnectionString = \”Provider = microsoft.jet.oledb.4.0;data source=\” & App.Path & \”\\db_rw.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false\”
.Open
End With
dlookuplink_rs.CursorLocation = adUseClient
Dim dlookuplink_sql As String
If rscondition <> \”\” Then
dlookuplink_sql = \”Select * From \” & rstable & \” where \” & rscondition
Else
dlookuplink_sql = \”Select * From \” & rstable
End If
dlookuplink_rs.Open dlookuplink_sql, dlookuplink_conn, adOpenDynamic, adLockOptimistic
If dlookuplink_rs.EOF = False Then
dlookuplink = dlookuplink_rs.Fields(rsfieldname)
Else
dlookuplink = nullvalue
End If
dlookuplink_rs.Close
Set dlookuplink_rs = Nothing
dlookuplink_conn.Close
Set dlookuplink_conn = Nothing
Exit Function
查找记录出错:
dlookuplink_rs.Close
Set dlookuplink_rs = Nothing
dlookuplink_conn.Close
Set dlookuplink_conn = Nothing
dlookuplink = nullvalue
MsgBox Err.Description
End Function
Public Function dcountlink(ByVal rsfieldname As String, ByVal rstable As String, ByVal rscondition As String, ByVal nullvalue As Long) As Long \’查询记录数量
Dim dcountlink_conn As New ADODB.Connection
Dim dcountlink_rs As New ADODB.Recordset
dcountlink = nullvalue
On Error GoTo 查找记录出错
With dcountlink_conn
.ConnectionString = \”Provider = microsoft.jet.oledb.4.0;data source=\” & App.Path & \”\\db_rw.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false\”
.Open
End With
dcountlink_rs.CursorLocation = adUseClient
Dim dcountlink_sql As String
If rscondition <> \”\” Then
dcountlink_sql = \”Select * From \” & rstable & \” where \” & rscondition
Else
dcountlink_sql = \”Select * From \” & rstable
End If
dcountlink_rs.Open dcountlink_sql, dcountlink_conn, adOpenDynamic, adLockOptimistic
If dcountlink_rs.EOF = False Then
dcountlink = dcountlink_rs.RecordCount
Else
dcountlink = nullvalue
End If
dcountlink_rs.Close
Set dcountlink_rs = Nothing
dcountlink_conn.Close
Set dcountlink_conn = Nothing
Exit Function
查找记录出错:
dcountlink_rs.Close
Set dcountlink_rs = Nothing
dcountlink_conn.Close
Set dcountlink_conn = Nothing
dcountlink = nullvalue
MsgBox Err.Description
End Function
Public Function FileFolderExists(strFullPath As String) As Boolean \’判断文件夹是否存在
On Error GoTo EarlyExit
If Not Dir(strFullPath, vbDirectory) = vbNullString Then FileFolderExists = True
EarlyExit:
On Error GoTo 0
End Function
word公文自动排版VBA代码，拿走不谢
Sub 文档初始化() \’公文格式初始化
Selection.WholeStory \’选择word 所有文档
Selection.ClearFormatting \’文档格式清除
Selection.Range.HighlightColorIndex = wdNoHighlight \’突出显示文本取消
With Selection.Paragraphs \’段落设置
.Alignment = wdAlignParagraphLeft \’左对齐
.LineSpacingRule = wdLineSpaceExactly \’行距固定28.8
.LineSpacing = 28.8
.IndentFirstLineCharWidth 3 \’首行缩进2个字符
End With
With Selection.Font \’字体设置
.Name = \”仿宋_GB2312\” \’字体名称
.Size = 16 \’三号字体
.ColorIndex = wdBlack \’黑色
End With
End Sub
Sub 标题正文设置()
With Selection.PageSetup \’页面设置
.TopMargin = CentimetersToPoints(3.7) \’顶端边距
.BottomMargin = CentimetersToPoints(3.5) \’底端边距
.LeftMargin = CentimetersToPoints(2.8) \’左边距
.RightMargin = CentimetersToPoints(2.6) \’右边距
\’.PageWidth = CentimetersToPoints(18.2) \’页面宽度
\’.PageHeight = CentimetersToPoints(25.7) \’页面高度
End With
\’字体设置
Dim title_reg, f_reg, s_reg, th_reg, fr_reg, k, mh, strA$
Set myRange = ActiveDocument.Content
\’ 正则表达式 获取文档内容
strA = myRange.Text
Set title_reg = CreateObject(\”vbscript.regexp\”)
Set f_reg = CreateObject(\”vbscript.regexp\”)
Set s_reg = CreateObject(\”vbscript.regexp\”)
Set th_reg = CreateObject(\”vbscript.regexp\”)
Selection.HomeKey unit:=wdStory \’光标回到文章开头
t = 0
title_reg.Pattern = \”\\r\\r\”
\'[^\\r]除了换行符之外的所有字符
title_reg.Global = True
Set Title = title_reg.Execute(strA)
With Selection.Find
.ClearFormatting
.Text = Title.Item(0)
.Execute Forward:=True
Selection.HomeKey unit:=wdStory, Extend:=wdExtend
End With
\’选择有两个换行符的至开头的所有段落
With Selection.Font
.Name = \”方正小标宋简体\”
.Size = 22
.ColorIndex = wdBlack
End With
With Selection.Paragraphs \’设置行距
.FirstLineIndent = CentimetersToPoints(0) \’取消首行缩进
.Alignment = wdAlignParagraphCenter \’段落居中
.LineSpacingRule = wdLineSpaceExactly \’行距固定
.LineSpacing = Word.Application.LinesToPoints(2.3) \’行距为2.3倍行距 一行距=12
End With
\’ 以下是设置一级标题
t1 = 0 \’初始化t1，作为一级标题是否是一是二是三是的标记，如果是，则为1，不是则为0
Selection.HomeKey unit:=wdStory
f_reg.Pattern = \”(一、|二、|三、|四、|五、|六、|七、|八、|九、|十、|十一、|十二、|十三、|十四、|十五、|十六、|十七、|十八、|十九、|二十、|二十一、|二十二、|二十三、|二十四、|二十五、|二十五、|二十五、|二十六、|二十七、|二十八、|二十九、|三十、)[^\\r]*\\r\”
f_reg.Global = True
Set f_titles = f_reg.Execute(strA)
If f_titles.Count = 0 Then \’如果一级标题是一是二是三是，则匹配
f_reg.Pattern = \”(一是|二是|三是|四是|五是|六是|七是|八是|九是|十是|十一是|十二是|十三是|十四是|十五是|十六是|十七是|十八是|十九是|二十是|二十一是|二十二是|二十三是|二十四是|二十五是|二十六是|二十七是|二十八是|二十九是|三十是)([^。])*。\”
Set f_titles = f_reg.Execute(strA)
t1 = 1
End If
For Each f_title In f_titles
With Selection.Find
.ClearFormatting
.Text = f_title.Value
Debug.Print \”一级标题遍历项目：\”; f_title.Value
.Execute Forward:=True
End With
With Selection.Font
.Name = \”黑体\”
.Size = \”16\”
.ColorIndex = wdBlack
End With
Selection.HomeKey unit:=wdStory
Next
\’ 以下是设置二级标题
If t1 = 0 Then \’p判断一级标题是否是一是二是三是的标记，如果是0，则不是一是二是三是，则执行，不是则不执行
t2 = 0
Selection.HomeKey unit:=wdStory
s_reg.Global = True
s_reg.Pattern = \”(（一）|（二）|（三）|（四）|（五）|（六）|（七）|（八）|（九）|（十）|（十一）|（十二）|（十三）|（十四）|（十五）|（十六）|（十七）|（十八）|（十九）|（二十）|（二十一）|（二十二）|（二十三）|（二十四）|（二十五）|（二十六）|（二十七）|（二十八）|（二十九）|（三十）)([^。\\r：])*[。|\\r：]\” \’排除句号和段落符号查找所有，找到句号或段落符号后停止
Set s_titles = s_reg.Execute(strA)
If s_titles.Count = 0 Then \’如果二级标题是一是二是三是，则匹配
s_reg.Pattern = \”(一是|二是|三是|四是|五是|六是|七是|八是|九是|十是|十一是|十二是|十三是|十四是|十五是|十六是|十七是|十八是|十九是|二十是|二十一是|二十二是|二十三是|二十四是|二十五是|二十六是|二十七是|二十八是|二十九是|三十是)([^。])*。\”
Set s_titles = s_reg.Execute(strA)
t2 = 1
End If
For Each s_title In s_titles
With Selection.Find
.ClearFormatting
.Text = s_title.Value
Debug.Print \”二级标题遍历项目：\”; s_title.Value
.Execute Forward:=True
End With
With Selection.Font
.Name = \”楷体\”
.Size = \”16\”
.ColorIndex = wdBlack
.Bold = True
End With
Selection.HomeKey unit:=wdStory
Next
End If
\’ 以下是设置三级标题
If t2 = 0 Then
Selection.HomeKey unit:=wdStory
th_reg.Global = True
th_reg.Pattern = \”\\r\\d{1,2}\\.([^。])*。\”
Set th_titles = th_reg.Execute(strA)
If th_titles.Count = 0 Then \’如果三级标题是一是二是三是，则匹配
th_reg.Pattern = \”(一是|二是|三是|四是|五是|六是|七是|八是|九是|十是|十一是|十二是|十三是|十四是|十五是|十六是|十七是|十八是|十九是|二十是|二十一是|二十二是|二十三是|二十四是|二十五是|二十六是|二十七是|二十八是|二十九是|三十是)([^。])*。\”
Set th_titles = th_reg.Execute(strA)
End If
For Each th_title In th_titles
With Selection.Find
.ClearFormatting
.Text = th_title.Value
Debug.Print \”三级标题遍历项目：\”; th_title.Value
.Execute Forward:=True
End With
With Selection.Font
.Bold = True
.ColorIndex = wdBlack
End With
Selection.HomeKey unit:=wdStory
Next
End If
End Sub
Sub 页码设置()
ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).PageNumbers.Add PageNumberAlignment:=wdAlignPageNumberCenter, FirstPage:=True
With ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary) \’进入页脚编辑状态
.Range.Font.Size = 15
.Range.Font.Name = \”仿宋\”
.Range.Collapse Direction:=wdCollapseEnd
End With
End Sub
Sub 删除页眉横线()
With ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range \’进入页脚编辑状态
.Delete \’删除页眉中的内容
.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleNone \’段落下边框线
End With
End Sub
Sub 公文格式排版()
Call 文档初始化
Call 标题正文设置
Call 页码设置
Call 删除页眉横线
End Sub
VB编程（七）关键字、标识符和数据类型
关键字是指系统中使用的具有特定意义的字符，不能用于定义变量的操作。
常见的关键字有：Dim、Private 、Public 、Static 、Sub 、End 、If 、Else 、From 、Me等等。
标识符用来命名常量、变量、模块、类、函数等，命名规则：
（1）不能使用系统中的关键字
（2）第一个字符必须是字母，后边可以是字母、数字、下划线
（3）不区分大小写
数据类型分以下几种：
数字型
整型 Integer ：由2个字节的二进制数来存储，取值的范围是-32768 ~ +32768 ，声明符 %
长整型 Long ：由4个字节的二进制数来存储，取值的范围是-2147483648 ~ 2147483647，声明符 &
单精度 Single ：由4个字节的二进制数存储，最多可以表达7位有效数字，声明符 !
双精度 Double ：由4个字节的二进制数存储，最多可以表达15位有效数字，声明符 #
货币型 Currency ：由8个字节的二进制数存储，声明符 @
字节型 Byte ：由1个字节的二进制数存储
字符型
String 声明符 $
字符型包含定长字符串和变长字符串
变长字符串在不超过取值范围的情况下存储任意长度的字符串
定长字符串只能存储指定长度的字符串 String*常数，如果存储的字符 串不足常数指定的长度会用空格补齐，如果超出指定长度超出部分会舍弃。
例如：
定义字符串
上图中的变长字符串在不超过取值范围的情况下存储任意长度的字符 串，定长度为5 如果多了只保留前五个，比如 str2 = “abcdefg” 实际只会存 储”abcde”。
布尔型
Boolean ：由2个字节的二进制数存储，只有两个值 True 和 False
True 对应数字型 -1
False 对应数字型 0
日期型
Date #2020 – 10 – 10# 要用#包起来
Variant 可以存储任何类型的数据
可以自己定义数据类型，在下图中，定义一个学生类型Student，其中的属性包含姓名、年龄、住址。
定义完之后就可以在代码中使用了。
自定义变量
本文作者及来源:Renderbus瑞云渲染农场https://www.renderbus.com
文章为作者独立观点不代本网立场，未经允许不得转载。
投诉举报&联系我们：
