VBA: EXCEL通过DDE通讯读取数据生成报表

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