前言

设备检点在生产过程当中是一个常态化工作，也是一个动态连续过程，通过对设备巡回检查可以提前发现问题，提前解决，也是落实安全生产的一个重要内容。

下面制作了一个检点记录的过程方法，可以实现添加、查询、删除、打印、导出等等功能，如果在工作当中合理有效地利用，可以大大提高工作效率，通过一系列统计结果，可以得出哪些设备经常出现问题，于是可以着重处理。将会尽最大限度地避免不安全因素的发生。

上图为整个操作主页，分别设置了一些功能按钮，相应地实现其功能。

本应用，没有做过多的窗体设计，只需要在此页进行即可完成其它功能，所有的处理代码实现隐藏运行，减少了对代码不熟悉的一些问题。

或以简单入手，针对不同的设置信息，可以自由设置。

所以也适合不同类型的设备检点过程。

下面看一下代码

查询过程

Private Sub 查询()On Error Resume NextApplication.DisplayAlerts = FalseApplication.ScreenUpdating = FalseThisWorkbook.Worksheets("检点记录").SelectDim xArrxArr = ActiveSheet.UsedRangeActiveSheet.UsedRange.Rows.Hidden = FalseDim xR As Long, xc As Long, xi As Integer, ci As Integer, cc As IntegerxR = 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 IfNext xiErase xArrApplication.DisplayAlerts = TrueApplication.ScreenUpdating = TrueEnd Sub

查询过程通过一个简单的隐藏功能来实现，如果查询到信息即显示在表格中，不符合查询条件就隐藏掉，代码简单，理论也简单没有过多深度理解的内容。

文件导出

Private Sub SaveFiles() '导出文件On Error Resume NextDim xSheetName As StringDim isTrue As IntegerxSheetName = VBA.InputBox("输入文件名...", "导出文件", VBA.Format(VBA.Date, "yyyymmdd"))If VBA.Len(VBA.Trim(xSheetName)) = 0 Then Exit SubIf VBA.Dir(ThisWorkbook.Path & "\" & xSheetName & ".xlsx") <> "" Then    isTrue = MsgBox("文件已经存在！是否要覆盖？", vbYesNo, "提示")    If isTrue <> 6 Then Exit SubEnd IfApplication.DisplayAlerts = FalseApplication.ScreenUpdating = FalseApplication.CutCopyMode = FalseActiveSheet.Cells(2, 1).Resize(ActiveSheet.UsedRange.Rows.Count - 1, ActiveSheet.UsedRange.Columns.Count).CopyDim xExcel As Excel.ApplicationDim xBook As WorkbookDim xSheet As WorksheetSet xExcel = CreateObject("Excel.Application")'新建应用Set xBook = xExcel.Workbooks.AddSet xSheet = xBook.Worksheets(1)xSheet.Cells(1, 1).PasteSpecial xlPasteAllxSheet.Name = xSheetNamexExcel.Visible = TruexBook.SaveAs ThisWorkbook.Path & "\" & xSheetName & ".xlsx"xBook.ClosexExcel.QuitIf Err.Number = 0 Then    MsgBox "文件导出成功！" & VBA.vbCrLf & xSheetName, vbInformation, "提示"End IfApplication.DisplayAlerts = TrueApplication.ScreenUpdating = TrueApplication.CutCopyMode = TrueEnd Sub

文件导出功能是很实用的功能，可以十分方便地将当前数据备份到新工作表中，为此做了一些代码处理，而且此代码也可以直接使用，有兴趣可以复制应用一下。

此应用还有一些未完善的功能，比如统计功能，经过一些数据统计可得到一些想要的结果，如有必要下一步继续完成一下。

欢迎关注、收藏

---END---