VBA-窗体程序,制作一个简单的窗口来进行数据的增删改

1.在这里主要以一个人员薪酬表为例子,做简单的增删改等操作,以及快速生成工资条,窗口示例如下


2.数据表信息如下


3.生成的工资表如下


4.详细代码如下

'添加员工信息
Private Sub CommandButton1_Click()
Dim i
Dim w1
Set w1 = Worksheets(1)


i = 2
While w1.Cells(i, 1) <> ""
i = i + 1
Wend
If TextBox1 = "" Then
MsgBox "工号不能为空!", vbOKOnly
'将对应的信息填写在工作表中
End If
If TextBox1 <> "" Then
w1.Cells(i, 1) = TextBox1.Text
w1.Cells(i, 2) = TextBox2.Text
w1.Cells(i, 3) = ListBox1.Text
w1.Cells(i, 4) = ListBox2.Text
w1.Cells(i, 5) = TextBox3.Text
w1.Cells(i, 6) = TextBox4.Text
End If
MsgBox "添加完成", vbOKOnly
End Sub
'删除员工信息
Private Sub CommandButton2_Click()
Dim i
Dim w1
Set w1 = Worksheets(1)
i = 2
While w1.Cells(i, 1) <> TextBox1.Text And w1.Cells(i, 1) <> ""
 i = i + 1
Wend
'将对应的信息显示在对应的文本框中
    If w1.Cells(i, 1) = TextBox1.Text Then
    TextBox2.Text = w1.Cells(i, 2)
    ListBox1.Text = w1.Cells(i, 3)
    ListBox2.Text = w1.Cells(i, 4)
    TextBox3.Text = w1.Cells(i, 5)
    TextBox4.Text = w1.Cells(i, 6)
    respose = MsgBox("确定删除吗?", vbOKCancel)
             If respose = vbOK Then
            Range("A" & i, "I" & i).Select
            Selection.Delete Shift:=xlUp
            MsgBox "删除完成", vbOKOnly
            End If
            If respose = vbCancel Then
            w1.Cells(i, 1) = TextBox1.Text
            w1.Cells(i, 2) = TextBox2.Text
            w1.Cells(i, 3) = ListBox1.Text
            w1.Cells(i, 4) = ListBox2.Text
            w1.Cells(i, 5) = TextBox3.Text
            w1.Cells(i, 6) = TextBox4.Text
    
            End If
    End If
    If w1.Cells(i, 1) <> TextBox1.Text Then
    MsgBox "未找到该工号,请确认工号是否有误!"
    End If
End Sub
'修改员工信息
Private Sub CommandButton3_Click()
Dim i
Dim w1
Set w1 = Worksheets(1)
i = 2
While w1.Cells(i, 1) <> TextBox1.Text And w1.Cells(i, 1) <> ""
 i = i + 1
Wend
    If w1.Cells(i, 1) = TextBox1.Text Then
    TextBox2.Text = w1.Cells(i, 2)
    ListBox1.Text = w1.Cells(i, 3)
    ListBox2.Text = w1.Cells(i, 4)
    TextBox3.Text = w1.Cells(i, 5)
    TextBox4.Text = w1.Cells(i, 6)
    respose = MsgBox("确定修改吗?", vbOKCancel)
             If respose = vbOK Then
            w1.Cells(i, 1) = TextBox1.Text
            w1.Cells(i, 2) = TextBox2.Text
            w1.Cells(i, 3) = ListBox1.Text
            w1.Cells(i, 4) = ListBox2.Text
            w1.Cells(i, 5) = TextBox3.Text
            w1.Cells(i, 6) = TextBox4.Text
            MsgBox "修改完成", vbOKOnly
            End If
            If respose = vbCancel Then
    
            End If
    End If
     If w1.Cells(i, 1) <> TextBox1.Text Then
    MsgBox "未找到该工号,请确认工号是否有误!"
    End If
End Sub
'一键生成工资表
Private Sub CommandButton4_Click()
Dim i, j
Dim w1, w3
Set w1 = Worksheets(1)
Set w3 = Worksheets(3)
i = 1
j = 1
While w1.Cells(i, 1) <> ""
i = i + 1
Wend
While w1.Cells(1, j) <> ""
j = j + 1
Wend
'将数据复制到指定工作表
Sheets("Sheet1").Activate
Sheets("Sheet1").Range(Cells(1, 1), Cells(i, j)).Select
 Selection.Copy
    Sheets("Sheet3").Select
    Range("A1").Select
    ActiveSheet.Paste
    i = 2
'插入标题行
    While w3.Cells(i, 1) <> ""
  
        If (i Mod 2) = 1 Then
       w3.Range(Cells(1, 1), Cells(1, j)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet3").Activate
    Sheets("Sheet3").Range("A" & i).Select
    Selection.Insert Shift:=xlDown
    End If
        i = i + 1
    Wend
    i = 2
    '插入空白行
    While Cells(i, 1) <> ""
        If (i Mod 3) = 0 Then
         Sheets("Sheet3").Activate
         Sheets("Sheet3").Range("A" & i).Select
         Application.CutCopyMode = False
         Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
         End If
    i = i + 1
    Wend
End Sub

 
 



猜你喜欢

转载自blog.csdn.net/qq_41777527/article/details/80231713
今日推荐