言

設備檢點在生產過程當中是一個常態化工作，也是一個動態連續過程，通過對設備巡回檢查可以提前發現問題，提前解決，也是落實安全生產的一個重要內容。

下面制作了一個檢點記錄的過程方法，可以實現添加、查詢、刪除、打印、導出等等功能，如果在工作當中合理有效地利用，可以大大提高工作效率，通過一系列統計結果，可以得出哪些設備經常出現問題，于是可以著重處理。將會盡最大限度地避免不安全因素的發生。

上圖為整個操作主頁，分別設置了一些功能按鈕，相應地實現其功能。

本應用，沒有做過多的窗體設計，只需要在此頁進行即可完成其它功能，所有的處理代碼實現隱藏運行，減少了對代碼不熟悉的一些問題。

或以簡單入手，針對不同的設置信息，可以自由設置。

所以也適合不同類型的設備檢點過程。

下面看一下代碼

查詢過程

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---

】原理簡述

在第1課中已經闡述了如何將PLC的數據通過OPC(kepeare）如何定時寫入mssql數據庫中，日報表是通過數據庫查詢語句將MSSQL表的內容按照時間查詢并顯示到flexcell表格中。主要的設計流程：

（1）建立數據庫的連接

（2）利用數據庫的查詢語句，按照選擇日期時間，查詢數據。

【二】基礎功能設計

2.1 界面設計

幾大控件

（1）時間控件DTpicker

(2) 按鈕控件 commandbutton

（3）通訊CommonDialog

（4）表格控件Grid

查詢代碼：

打印代碼

初始化代碼

數據導出代碼

'以下為鏈接數據庫SQL

Const g_conString=" Provider=MSDASQL.1;Persist Security Info=False;Data Source=SQL_KEP;Initial Catalog=SQL_KEP" '數據庫連接代碼

Dim g_value(100) As String

Private Sub Command1_Click() '導出到Excel文件

ss=CommonDialog1.FileName

CommonDialog1.ShowSave

If ss <> CommonDialog1.FileName Then

Grid1.ExportToExcel (CommonDialog1.FileName + ".xls")

End If

End Sub

Private Sub Command2_Click() '查詢按鈕

Dim strsql

Dim cn As ADODB.Connection

Dim record As ADODB.Recordset

Set cn=New ADODB.Connection

cn.Open g_conString

Set record=New ADODB.Recordset

st=Str(d_start_date.Value)

If Len(st) < 14 Then '

st=st + " 00:00:00"

End If

st1=Str(d_end_date.Value)

If Len(st1) < 14 Then '

st1=st1 + " 000:00:00"

End If

strsql="select tt,t1,t2,t3,t4,t5 from tt1 where TT>='" + st + "' and TT<='" + st1 + "'order by xh" '此處只查詢了5個數據

'查詢語句 從SQL的tt1表格中 查詢 tt,t1,t2,t3,t4,t5 數據， 時間介于

record.Open strsql, cn

j=2 '目錄列

Grid1.Rows=1

If record.EOF=True Then

record.Close

Set record=Nothing

cn.Close

Set cn=Nothing

Exit Sub

End If

Dim maxv(5) As Single

Dim minv(5) As Single

Dim avg(5) As Single

For i=0 To 4

maxv(i)=-10000

minv(i)=10000

avg(i)=0

Dim cxv As Single

Next i

Dim num As Integer

num=0

Do While record.EOF=False

Grid1.Rows=j + 4

Grid1.Cell(j, 0).Text=Str(j)

st3=Str(CDate(record.Fields(0)))

If Len(st3) < 14 Then

st3=st3 + " 00:00:00"

End If

Grid1.Cell(j, 1).Text=st3

For i=1 To 5

num=num + 1

If record.Fields(i) > -10000 Then

cxv=record.Fields(i)

Else

cxv=0

End If

If i=1 Then

'增加一行可以否則EXCEL導出沒有名稱）

Grid1.Cell(1, 1).Text="日期時間"

Grid1.Cell(1, 2).Text="取水液位"

Grid1.Cell(1, 3).Text="進水流量"

Grid1.Cell(1, 4).Text="進水濁度"

Grid1.Cell(1, 5).Text="1#儲藥罐液位"

Grid1.Cell(1, 6).Text="2#儲藥罐液位"

Grid1.Cell(j, i + 1).Text=Format(cxv, "0.000") + " 米" '數據標準化及單位

End If

If i=2 Then

Grid1.Cell(j, i + 1).Text=Format(cxv, "0") + " m3/h"

End If

If i=3 Then

Grid1.Cell(j, i + 1).Text=Format(cxv, "0.00") + " NTU"

End If

If i=4 Then

Grid1.Cell(j, i + 1).Text=Format(cxv, "0.000") + " 米"

End If

If i=5 Then

Grid1.Cell(j, i + 1).Text=Format(cxv, "0.000") + " 米"

End If

If maxv(i - 1) < cxv Then

maxv(i - 1)=cxv

End If

If minv(i - 1) > cxv Then

minv(i - 1)=cxv

End If

avg(i - 1)=avg(i - 1) + cxv

Next i

'num=num + 1

j=j + 1

record.MoveNext

Loop

Grid1.Cell(j, 1).Text="平均值"

Grid1.Cell(j + 1, 1).Text="最大值"

Grid1.Cell(j + 2, 1).Text="最小值"

For i=0 To 4

If i=0 Then

Grid1.Cell(j, i + 2).Text=Format(avg(i) / num, "0.000") + " 米"

Grid1.Cell(j + 1, i + 2).Text=Format(maxv(i), "0.000") + " 米"

Grid1.Cell(j + 2, i + 2).Text=Format(minv(i), "0.000") + " 米"

End If

If i=1 Then

Grid1.Cell(j, i + 2).Text=Format(avg(i) / num, "0") + " m3/h"

Grid1.Cell(j + 1, i + 2).Text=Format(maxv(i), "0") + " m3/h"

Grid1.Cell(j + 2, i + 2).Text=Format(minv(i), "0") + " m3/h"

End If

If i=2 Then

Grid1.Cell(j, i + 2).Text=Format(avg(i) / num, "0.00") + " NTU"

Grid1.Cell(j + 1, i + 2).Text=Format(maxv(i), "0.00") + " NTU"

Grid1.Cell(j + 2, i + 2).Text=Format(minv(i), "0.00") + " NTU"

End If

If i=3 Then

Grid1.Cell(j, i + 2).Text=Format(avg(i) / num, "0.000") + " 米"

Grid1.Cell(j + 1, i + 2).Text=Format(maxv(i), "0.000") + " 米"

Grid1.Cell(j + 2, i + 2).Text=Format(minv(i), "0.000") + " 米"

End If

If i=4 Then

Grid1.Cell(j, i + 2).Text=Format(avg(i) / num, "0.000") + " 米"

Grid1.Cell(j + 1, i + 2).Text=Format(maxv(i), "0.000") + " 米"

Grid1.Cell(j + 2, i + 2).Text=Format(minv(i), "0.000") + " 米"

End If

Next i

record.Close

Set record=Nothing

cn.Close

Set cn=Nothing

End Sub

Private Sub Command3_Click()

Grid1.PrintPreview '打印預覽

End Sub

Private Sub Form_Initialize()

Grid1.SetRegisterInformation "CNwinndy", "W]vyY-nonvk-u\nty-Zbl_e-`hms^" '注冊flexcell表格控件

Grid1.PageSetup.Orientation=cellLandscape

Grid1.Cols=7

'以下為設置表格第一行的名稱

Grid1.Cell(0, 1).Text="日期時間"

Grid1.Cell(0, 2).Text="取水液位"

Grid1.Cell(0, 3).Text="進水流量"

Grid1.Cell(0, 4).Text="進水濁度"

Grid1.Cell(0, 5).Text="1#儲藥罐液位"

Grid1.Cell(0, 6).Text="2#儲藥罐液位"

'以下為設置表格寬度

Grid1.Column(1).Width=130

Grid1.Column(2).Width=100

Grid1.Column(3).Width=100

Grid1.Column(4).Width=100

Grid1.Column(5).Width=100

Grid1.Column(6).Width=100

Grid1.PageSetup.PrintFixedRow=True

Grid1.PageSetup.PrintGridlines=True

d_start_date.Value=Now

d_end_date.Value=Now

End Sub

Private Sub Grid1_AfterReorderColumn(ByVal OriginalPosition As Long, ByVal NewPosition As Long)

Grid1.SetRegisterInformation "CNwinndy", "W]vyY-nonvk-u\nty-Zbl_e-`hms^"

End Sub

以上為日報表的源代碼

其他數據與此相同

In_data1,in_data2,in_data3都代碼相似