1. Excel2003下的VBA编程,和语法结果VB6.0一样,可以说是vb6的子集。
2. 编程环境:office2003下的 “visual basic 编辑器”。
3. 完整代码:请从资源中下载。
4. 窗口设计截图如下:
5. 部分代码示例:
Option Explicit
Private Sub UserForm_Initialize()
Dim iYear As Integer
Dim iMonth As Integer
Dim iDay As Integer
iYear = Year(Now)
iMonth = Month(Now)
iDay = Day(Now)
If iYear > 2010 Or iYear < 2005 Then
LabYear.Caption = "2005"
LabMonth.Caption = "1"
LabDay.Caption = "1"
SpinButtonYear.Value = 2005
SpinButtonMonth.Value = 1
SpinButtonDay.Value = 1
End If
LabYear.Caption = iYear
LabMonth.Caption = iMonth
LabDay.Caption = iDay
SpinButtonYear.Value = iYear
SpinButtonMonth.Value = iMonth
SpinButtonDay.Value = iDay
'ComboBoxSB.AddItem ("1#压风机")
ComboBoxSB.AddItem ("2#压风机")
ComboBoxSB.AddItem ("3#压风机")
ComboBoxSB.AddItem ("4#压风机")
End Sub
Private Sub CommandButtonMake_Click()
If Trim(Sheet4.Cells(1, 1)) = "" Or Trim(Sheet4.Cells(2, 1)) = "" Or Trim(Sheet4.Cells(10, 1)) = "" Then
Exit Sub
End If
Application.ScreenUpdating = False
Sheet1.Unprotect
Sheet1.Range("a5:n294").Clear
If ComboBoxSB.Text = "" Then
MsgBox ("请选择运转设备")
GoTo exit_safe
End If
DeleteFile (Sheet4.Cells(7, 1).Value)
Dim sYear, sMonth, sDay As String
sYear = Right(LabYear.Caption, 2)
If Len(LabMonth.Caption) = 1 Then
sMonth = "0" & LabMonth.Caption
Else
sMonth = LabMonth.Caption
End If
If Len(LabDay.Caption) = 1 Then
sDay = "0" & LabDay.Caption
Else
sDay = LabDay.Caption
End If
Dim file1, file2 As String
file1 = Trim(Sheet4.Cells(1, 1)) & "\" & sYear & sMonth & sDay & "00.idx"
file2 = Trim(Sheet4.Cells(1, 1)) & "\" & sYear & sMonth & sDay & "00.lgh"
Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.fileExists(file1) = False Or fs.fileExists(file2) = False Then
MsgBox ("该天没数据")
GoTo exit_safe
End If
Dim sTags As String
Select Case ComboBoxSB.Text
Case "1#压风机"
sTags = "$DATE,$TIME,A00001,A00002,A00003,A00004,A00254,A00253,A00252,A00251,A00250,A00249,A00247,A00248"
Case "2#压风机"
sTags = "$DATE,$TIME,A00013,A00014,A00015,A00016,A00262,A00261,A000260,A00259,A00258,A00257,A00255,A00256"
Case "3#压风机"
sTags = "$DATE,$TIME,A00061,A00062,A00063,A00064,A00270,A00269,A00268,A00267,A00266,A00265,A00263,A00264"
Case "4#压风机"
sTags = "$DATE,$TIME,A00067,A00068,A00069,A00070,A00278,A00277,A00276,A00275,A00274,A00273,A00271,A00272"
End Select
Select Case MultiPage1.Value
Case 0
Sheet4.Cells(3, 1).Value = """" & LabYear.Caption & "-" & sMonth & "-" & sDay & """"
Sheet4.Cells(4, 1).Value = """" & "00:00:00" & """"
Sheet4.Cells(5, 1).Value = "24h"
Sheet4.Cells(6, 1).Value = "5m"
Sheet4.Cells(8, 1).Value = sTags
Sheet4.Cells(9, 1).Value = 1
Call GetHistdata
If isHaveFile(Trim(Sheet4.Cells(7, 1))) = False Then
MsgBox ("没有发现文件")
GoTo exit_safe
End If
If isRightFile = False Then
MsgBox ("该天数据不正确")
GoTo exit_safe
End If
Call SetSheetLab
If OptionButtonMax1.Value = True Then
Call WriteMax1
Call pLine(24)
ElseIf OptionButtonAverage1.Value = True Then
Call WriteAverage1
Call pLine(24)
End If
Case 1
Dim sStart, sHour As String
sStart = LabStart.Caption
sHour = (CInt(LabEnd.Caption) - CInt(LabStart.Caption) + 1) & "h"
Sheet4.Cells(3, 1).Value = """" & LabYear.Caption & "-" & sMonth & "-" & sDay & """"
Sheet4.Cells(4, 1).Value = """" & sStart & ":00:00" & """"
Sheet4.Cells(5, 1).Value = sHour
Sheet4.Cells(6, 1).Value = "5m"
Sheet4.Cells(8, 1).Value = sTags
Sheet4.Cells(9, 1).Value = 1
Call GetHistdata
If isHaveFile(Trim(Sheet4.Cells(7, 1))) = False Then
MsgBox ("没有发现文件")
GoTo exit_safe
End If
If isRightFile = False Then
MsgBox ("该天数据不正确,请查看log.txt文件")
GoTo exit_safe
End If
Call SetSheetLab
Dim i As Integer
i = (CInt(LabEnd.Caption) - CInt(LabStart.Caption) + 1) * 12
Call WriteIn(i)
Call ppLine(i)
End Select
exit_safe:
Columns("F:F").Select
Selection.NumberFormatLocal = "#0.00_ "
Sheet1.Protect
Application.ScreenUpdating = True
End Sub