vba窗体

Posted 2020-09-23

Private Sub CommandButton1_Click()
‘ If IsDate(TextBox1.Text) = False Then
‘ MsgBox "请输入日期！"
‘ Exit Sub
‘ End If
If 类别 = "" Or 维修部件 = "" Or 部门 = "" Or 申请人 = "" Or 资产编号 = "" Or 维修数量.Value = "" Then
MsgBox "请完整输入，重新输入！"
Exit Sub
End If
Dim i&, r&, sh As Worksheet
On Error Resume Next
Set sh = Sheets("维修申请单")
If Not sh Is Nothing Then
With sh
r = .Range("b65536").End(xlUp).Row + 1
.Cells(r, 1) = 维修编号.Text
.Cells(r, 2) = 部门.Text
.Cells(r, 3) = 申请人.Text
.Cells(r, 4) = 类别.Text
.Cells(r, 5) = 维修部件.Text
.Cells(r, 8) = 资产编号.Text
.Cells(r, 7) = 维修数量.Value
.Cells(r, 6) = 简要描述.Text
.Cells(r, 9) = Worksheets("参数1").Cells(2, 3)

End With
MsgBox "数据录入成功！", , "系统提示"
End If
End Sub
Private Sub CommandButton2_Click()

Set sh = Sheets("维修申请单")
arr = sh.Range("A2").Resize(Range("b65536").End(xlUp).Row + 1, 8) ‘Range("b65536").End(xlUp).Row A列最后一个非空单元格的行号
For i = 1 To UBound(arr)
If Str(arr(i, 1)) = Str(维修编号.Text) Then
维修编号 = arr(i, 1)
部门 = arr(i, 2)
申请人 = arr(i, 3)
类别 = arr(i, 4)
维修部件 = arr(i, 5)
资产编号 = arr(i, 8)
维修数量 = arr(i, 7)
简要描述 = arr(i, 6)
End If
: Next
If 维修编号 = "" Then MsgBox "订单号:" & TextBox2 & " 不存在！", , "系统提示": Exit Sub
End Sub
Private Sub CommandButton3_Click()
Set sh = Sheets("维修申请单")
If Not sh Is Nothing Then
arr = sh.Range("A2").Resize(Range("A65500").End(3).Row + 1, 8)
For i = 1 To UBound(arr)
If Str(arr(i, 1)) = Str(维修编号.Text) Then
arr(i, 1) = 维修编号.Text
arr(i, 2) = 部门.Text
arr(i, 3) = 申请人.Text
arr(i, 4) = 类别.Text
arr(i, 5) = 维修部件.Text
arr(i, 8) = 资产编号.Text
arr(i, 7) = 维修数量.Value
arr(i, 6) = 简要描述.Text

sh.Range("A2").Resize(Range("A65500").End(3).Row + 1, 8) = arr
End If: Next: End If
MsgBox "维修编号: " & 维修编号 & " 数据已修改！", , "系统提示"
End Sub
Private Sub CommandButton4_Click()
Set sh = Sheets("维修申请单")
If Not sh Is Nothing Then
arr = sh.Range("A2").Resize(Range("A65500").End(3).Row + 1, 8)
For i = 1 To UBound(arr)
If Str(arr(i, 1)) = Str(维修编号.Text) Then
sh.Rows(i + 1).Delete
N = arr(i, 1)
End If: Next: End If
If N = "" Then MsgBox "维修编号:" & 维修编号 & " 不存在！", , "系统提示": Exit Sub
MsgBox "维修编号:" & N & " 已删除！", , "系统提示"
End Sub

Private Sub CommandButton5_Click()
Dim i, num1, k
num1 = Sheets("维修申请单").Cells(65536, 1).End(xlUp).Row
Worksheets("维修核查单").Unprotect Password:="111111" ‘取消密码保护
Worksheets("维修审核单").Unprotect Password:="111111"
Sheets("维修核查单").Range("2:65536").Clear ‘从第二行开始清空工作表
Sheets("维修审核单").Range("2:65536").Clear
For i = 1 To num1
For k = 1 To 9
Sheets("维修核查单").Cells(i, k) = Sheets("维修申请单").Cells(i, k)
Sheets("维修审核单").Cells(i, k) = Sheets("维修申请单").Cells(i, k)
Next k
Next i
Worksheets("维修核查单").Protect Password:="111111" ‘添加密码保护
Worksheets("维修审核单").Protect Password:="111111"
Worksheets("维修申请单").Protect Password:="111111" ‘密码保护
‘收集硬件信息
Call hardwareinfo ‘保存硬件信息
Unload Me

ThisWorkbook.Save ‘保存

ThisWorkbook.Close ‘关闭工作簿

End Sub

Private Sub UserForm_Initialize()
With Sheets("参数1") ‘部门combox项目
s = ","
For i = 2 To .Cells(65535, 1).End(xlUp).Row
If InStr(1, s, "," & .Cells(i, 1).Text & ",") = 0 Then
部门.AddItem .Cells(i, 1).Text
s = s & .Cells(i, 1).Text & ","
End If
Next i
End With

With Sheets("参数2") ‘类别combox项目
s = ","
For i = 2 To .Cells(65535, 1).End(xlUp).Row
If InStr(1, s, "," & .Cells(i, 1).Text & ",") = 0 Then
类别.AddItem .Cells(i, 1).Text
s = s & .Cells(i, 1).Text & ","
End If
Next i
End With

维修编号.Value = Year(Date) & Month(Date) & Day(Date) & Hour(Time) & Minute(Time) & Second(Time)
Worksheets("维修申请单").Unprotect Password:="111111" ‘取消密码保护


End Sub

Private Sub 部门_Change()
申请人.Clear
pm = 部门
d = ""
For i = 2 To 1000
Set c = Worksheets("参数1").Range("a" & i).Find(pm)
If Not c Is Nothing Then
If c.Offset(0, 1) <> d Then
d = c.Offset(0, 1)
申请人.AddItem d
End If
End If
Next
End Sub

Private Sub 类别_Change()
维修部件.Clear
pm = 类别
d = ""
For i = 2 To 1000
Set c = Worksheets("参数2").Range("a" & i).Find(pm)
If Not c Is Nothing Then
If c.Offset(0, 1) <> d Then
d = c.Offset(0, 1)
维修部件.AddItem d
End If
End If
Next
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) ‘让窗体的关闭按钮失效
If CloseMode <> 1 Then
Cancel = 1 ‘禁用窗体右上角的“×”
End If
End Sub