vba写的日常工作管理目录（带窗体）（条件自动突出等）
本帖最后由 sleony 于 2020-12-5 17:22 编辑Dim intclick_xz As Single, intclick_xg As Single, K As Integer, brr(), wMax As Integer
Option Explicit
Dim l As Integer, a As Integer, b As Integer
以上部分是变量声明
以下部分是窗体代码主体
-----------------------------
窗体加载前的各个窗体组件的复原
Private Sub UserForm_Initialize()
未完成.Value = False
完成.Value = False
intrownow = Sheets(4).Range("a65560").End(xlUp).Row
时间.Locked = True
事项.Locked = True
跟进.Locked = True
完成情况.Locked = True
按钮状态 Me, 4
时间.Text = Sheets(4).Range("a" & intrownow)
事项.Text = Sheets(4).Range("b" & intrownow)
跟进.Text = Sheets(4).Range("c" & intrownow)
完成情况.Text = Sheets(4).Range("D" & intrownow)
End Sub
----------------------------------------------
上一条按钮的点击事件代码
Private Sub 上一条_Click()
下一条.Enabled = True
If 未完成.Value = False Then
intrownow = intrownow - 1
ElseIf 未完成.Value = True And K > 0 And K <= wMax Then
intrownow = brr(1, K)
K = K - 1
ElseIf K = 0 Then MsgBox ("没有条目")
End If
按钮状态 Me, 4
时间.Text = Sheets(1).Range("a" & intrownow)
时间.Text = Sheets(4).Range("a" & intrownow)
事项.Text = Sheets(4).Range("b" & intrownow)
跟进.Text = Sheets(4).Range("c" & intrownow)
完成情况.Text = Sheets(4).Range("D" & intrownow)
End Sub
----------------------------------------------
下一条按钮的点击事件代码
Private Sub 下一条_Click()
Dim g As Integer
If K = 0 Then K = K + 1
If 未完成.Value = True And K < wMax + 1 Then
intrownow = brr(1, K)
K = K + 1
ElseIf 未完成.Value = True And K = wMax + 1 Then
MsgBox "最后一项"
ElseIf 未完成.Value = False Then
intrownow = intrownow + 1
End If
按钮状态 Me, 4
时间.Text = Sheets(4).Range("a" & intrownow)
事项.Text = Sheets(4).Range("b" & intrownow)
跟进.Text = Sheets(4).Range("c" & intrownow)
完成情况.Text = Sheets(4).Range("D" & intrownow)
End Sub
----------------------------------------------
新赠按钮的点击事件代码
Private Sub 新增_Click()
Dim l As Integer
l = Sheets(4).Range("a65560").End(xlUp).Row
intclick_xz = intclick_xz + 1
文本框状态
If intclick_xz Mod 2 = 1 Then
新增.Caption = "添加"
时间.Text = Format(Now, "short date")
事项.Text = ""
跟进.Text = ""
完成情况.Text = "未完成"
Else
新增.Caption = "新增"
Sheets(4).Range("a" & l + 1) = 时间.Text
Sheets(4).Range("b" & l + 1) = 事项.Text
Sheets(4).Range("c" & l + 1) = 跟进.Text
Sheets(4).Range("d" & l + 1) = 完成情况.Text
intrownow = l + 1
筛选突出 "未完成", "D"
Sheet4.Rows("1:1000").AutoFit
End If
End Sub
----------------------------------------------
修改按钮的点击事件代码
Private Sub 修改_Click()
intclick_xg = intclick_xg + 1
文本框状态
If intclick_xg Mod 2 = 1 Then
修改.Caption = "确认修改"
时间.SetFocus
Else
修改.Caption = "修改"
Sheets(4).Range("a" & intrownow) = 时间.Text
Sheets(4).Range("b" & intrownow) = 事项.Text
Sheets(4).Range("c" & intrownow) = 跟进.Text
Sheets(4).Range("d" & intrownow) = 完成情况.Text
筛选突出 "未完成", "D"
Sheet4.Rows("1:1000").AutoFit
End If
End Sub
----------------------------------------------
未完成单选按钮的点击事件代码
Private Sub 未完成_Click()
Dim arr(), i As Integer
l = Sheets(4).Range("a65560").End(xlUp).Row
ReDim arr(2 To l, 1)
ReDim brr(1, 1 To l)
For i = 2 To l
arr(i, 1) = Range("D" & i)
If arr(i, 1) = "未完成" Then
K = K + 1
brr(1, K) = i
End If
Next i
wMax = K
按钮状态 Me, 4
ReDim Preserve brr(1, 1 To K)
intrownow = brr(1, K)
时间.Text = Sheets(4).Range("a" & intrownow)
事项.Text = Sheets(4).Range("b" & intrownow)
跟进.Text = Sheets(4).Range("c" & intrownow)
完成情况.Text = Sheets(4).Range("D" & intrownow)
End Sub
----------------------------------------------
代码过程中对文本框状态设定代码
Public Sub 文本框状态()
If (intclick_xz Mod 2) > 0 Or (intclick_xg Mod 2) > 0 Then
时间.Locked = False
事项.Locked = False
跟进.Locked = False
完成情况.Locked = False
Else
时间.Locked = True
事项.Locked = True
跟进.Locked = True
完成情况.Locked = True
End If
End Sub
看得云里雾里的，大哥，能说一下或者具体的发一下步骤说明吗？ 分享的精神值得去学习，论坛感谢有您！ 感谢分享 看着排版不错，看着舒服！ 界面好看，谢谢分享。 正在学习vb，谢谢楼主的分享！！！ 钱纸而已 发表于 2020-12-6 01:10
请你帮忙写一段VBA筛选代码可以嘛
可以啊你发要求和文件过来
成品，发出来，学习一下，谢谢。
页:
[1]
2