Excel VBA ——如何快速填充纸质登记表

场景：

一些个地方肯定有人特别喜欢用纸质单据记录，但是对于实际执行人来讲，大多数单据其实填写相当有规律，频繁使用手写简直是浪费时间！因此本示例尝试解决这个问题。

要点：

1. 图片电子签名

2. 常用数据快速填充

3. 一键打印并记录台账

效果如下： 

1. 下拉选择常用信息，自动填充到左边的表格  2.点击打印按钮，自动将填写的信息写入台账，然后发送打印请求到打印机

 

代码非常简单

一个输出并打印

一个监测指定单元格是否变化，如果变化则将其对应的数据取出并填充。（利用了vlookup函数获取对应的唯一值）

对应打印按钮的代码：

Private Sub CommandButton2_Click()
    Dim Wb As Workbook
    Set Wb = ThisWorkbook
    Wb.Worksheets(1).PrintOut '打印
    
    lastline = Sheet3.Range("A65535").End(xlUp).Row + 1
    Sheet3.Cells(lastline, 1) = Sheet1.Range("E8").Value '日期填充
    Sheet3.Cells(lastline, 2) = Format(Sheet1.Range("G8").Value, "hh:mm:ss") '时间填充
    Sheet3.Cells(lastline, 3) = Sheet1.Range("F10").Value '科室名称填充
    Sheet3.Cells(lastline, 4) = Sheet1.Range("C10").Value '领取人姓名填充
    Sheet3.Cells(lastline, 5) = Sheet1.Range("B15").Value '备注填充
    '——————————————————
    Sheet1.Range("C4") = "" '申请时间清除
    Sheet1.Range("E8") = "" '领取日期清除
    Sheet1.Range("G8") = "" '领取时间清除
    Sheet1.Range("C10") = "" '领取人清除
    Sheet1.Range("F10") = "" '科室名称清除
    Sheet1.Range("C12") = "" '品类清除
    Sheet1.Range("B15") = "" '备注清除
    
End Sub

'监控J3单元格的变动
Private Sub Worksheet_Change(ByVal Target As Range)
    'On Error Resume Next

    If Target.Address(0, 0) = "J3" Then ''将事件限制在单元格a3的改变上
        Sheet1.Range("C4") = "" '申请时间清除
        Sheet1.Range("E8") = "" '领取日期清除
        Sheet1.Range("G8") = "" '领取时间清除
        Sheet1.Range("C10") = "" '领取人清除
        Sheet1.Range("F10") = "" '科室名称清除
        Sheet1.Range("C12") = "" '品类清除
        Sheet1.Range("B15") = "" '备注清除
        
        '重新赋值
        MyDate = Date
        MyTime = Now
        Debug.Print (MyTime)
        Debug.Print (MyDate)
        Debug.Print (MyHour)
        Sheet1.Range("C4") = MyTime '申请时间填充
        Sheet1.Range("E8") = MyDate '领取日期填充
        Sheet1.Range("G8") = Format(MyTime, "hh:mm:ss") '领取时间填充
        
        If Len(Sheet1.Range("J6")) < 2 Then
            Sheet1.Range("C10") = "" '领取人填充
        Else
            Sheet1.Range("C10") = Sheet1.Range("J6") '领取人填充
        End If
        Sheet1.Range("F10") = Sheet1.Range("J7") '科室名称填充
        Sheet1.Range("C12") = Sheet1.Range("J8") '品类填充
        
    End If
End Sub

附件：   百度盘     提取码: 7x1a