前言
设备检点在生产过程当中是一个常态化工作，也是一个动态连续过程，通过对设备巡回检查可以提前发现问题，提前解决，也是落实安全生产的一个重要内容。
下面制作了一个检点记录的过程方法，可以实现添加、查询、删除、打印、导出等等功能，如果在工作当中合理有效地利用，可以大大提高工作效率，通过一系列统计结果，可以得出哪些设备经常出现问题，于是可以着重处理。将会尽最大限度地避免不安全因素的发生。
上图为整个操作主页，分别设置了一些功能按钮，相应地实现其功能。
本应用，没有做过多的窗体设计，只需要在此页进行即可完成其它功能，所有的处理代码实现隐藏运行，减少了对代码不熟悉的一些问题。
或以简单入手，针对不同的设置信息，可以自由设置。
所以也适合不同类型的设备检点过程。
下面看一下代码
查询过程
Private Sub 查询()
On Error Resume Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
ThisWorkbook.Worksheets("检点记录").Select
Dim xArr
xArr = ActiveSheet.UsedRange
ActiveSheet.UsedRange.Rows.Hidden = False
Dim xR As Long, xc As Long, xi As Integer, ci As Integer, cc As Integer
xR = UBound(xArr, 1)
xc = UBound(xArr, 2)
ci = 2 '日期列
cc = 5 '单元列
For xi = 3 To xR
If VBA.Format(xArr(xi, ci), "yyyy/mm/dd") = VBA.Format(Me.DTPicker1.Value, "yyyy/mm/dd") And _
Me.ComboBox1.Value = xArr(xi, cc) Then
ActiveSheet.Rows(xi).Hidden = False'隐藏行
Else
ActiveSheet.Rows(xi).Hidden = True'显示行
End If
Next xi
Erase xArr
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
查询过程通过一个简单的隐藏功能来实现，如果查询到信息即显示在表格中，不符合查询条件就隐藏掉，代码简单，理论也简单没有过多深度理解的内容。
文件导出
Private Sub SaveFiles() '导出文件
On Error Resume Next
Dim xSheetName As String
Dim isTrue As Integer
xSheetName = VBA.InputBox("输入文件名...", "导出文件", VBA.Format(VBA.Date, "yyyymmdd"))
If VBA.Len(VBA.Trim(xSheetName)) = 0 Then Exit Sub
If VBA.Dir(ThisWorkbook.Path & "\" & xSheetName & ".xlsx") <> "" Then
isTrue = MsgBox("文件已经存在！是否要覆盖？", vbYesNo, "提示")
If isTrue <> 6 Then Exit Sub
End If
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.CutCopyMode = False
ActiveSheet.Cells(2, 1).Resize(ActiveSheet.UsedRange.Rows.Count - 1, ActiveSheet.UsedRange.Columns.Count).Copy
Dim xExcel As Excel.Application
Dim xBook As Workbook
Dim xSheet As Worksheet
Set xExcel = CreateObject("Excel.Application")'新建应用
Set xBook = xExcel.Workbooks.Add
Set xSheet = xBook.Worksheets(1)
xSheet.Cells(1, 1).PasteSpecial xlPasteAll
xSheet.Name = xSheetName
xExcel.Visible = True
xBook.SaveAs ThisWorkbook.Path & "\" & xSheetName & ".xlsx"
xBook.Close
xExcel.Quit
If Err.Number = 0 Then
MsgBox "文件导出成功！" & VBA.vbCrLf & xSheetName, vbInformation, "提示"
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.CutCopyMode = True
End Sub
文件导出功能是很实用的功能，可以十分方便地将当前数据备份到新工作表中，为此做了一些代码处理，而且此代码也可以直接使用，有兴趣可以复制应用一下。
此应用还有一些未完善的功能，比如统计功能，经过一些数据统计可得到一些想要的结果，如有必要下一步继续完成一下。
欢迎关注、收藏
---END---