frmdailyreport.frm

用VB6.0编写的关于车辆运输调度的系统

        MsgBox "Please choose the customer code ,product code and tank code!", vbOKOnly, "Information"
        Exit Sub
    End If
    date1 = ChangeDate(DTtime1.Value)
    date2 = ChangeDate(DTtime2.Value + 1)
    
    sSQL = "select inpdate, actleve from iltank where cuscode = " & CLng(cmb_cus.Text) & " and procode = " & CLng(cmb_pro.Text) & " and tnkcode = " & CLng(cmb_tank.Text) _
            & " and inpdate >= " & date1 & " and inpdate <= " & date2
            
    Set rsttank = Acs_cnt.Execute(sSQL)
    
    If rsttank.EOF Then
        MsgBox "No records,Please choose again!", vbOKOnly, "Information"
        Exit Sub
    End If
    
    rsttank.MoveFirst
    vasreport.MaxRows = 1
    SetValue vasreport, 1, 1, Mid(rsttank!inpdate, 1, 4) & "-" & Mid(rsttank!inpdate, 5, 2) & "-" & Mid(rsttank!inpdate, 7, 2)
    SetValue vasreport, 1, 2, rsttank!actleve
    rsttank.MoveNext
    lrow = 1
    Do While Not rsttank.EOF
        vasreport.MaxRows = vasreport.MaxRows + 1
        lrow = lrow + 1
        SetValue vasreport, lrow, 1, Mid(rsttank!inpdate, 1, 4) & "-" & Mid(rsttank!inpdate, 5, 2) & "-" & Mid(rsttank!inpdate, 7, 2)
        SetValue vasreport, lrow, 2, rsttank!actleve
        SetValue vasreport, (lrow - 1), 3, (GetValue(vasreport, lrow - 1, 2) - rsttank!actleve)
        If GetValue(vasreport, lrow - 1, 3) > 0 Then
            sumcost = sumcost + GetValue(vasreport, lrow - 1, 3)
        End If
        rsttank.MoveNext
    Loop
    rsttank.Close
    Set rsttank = Nothing
    sSQL = "select min(inpdate) as date1,max(inpdate)as date2 from iltank where cuscode = " & CLng(cmb_cus.Text) & " and procode = " & CLng(cmb_pro.Text) & " and tnkcode = " & CLng(cmb_tank.Text) _
            & " and inpdate >= " & date1 & " and inpdate <= " & date2
    Set rsttank = Acs_cnt.Execute(sSQL)
    sdate1 = CStr(rsttank!date1)
    sdate2 = CStr(rsttank!date2)
    sdate1 = Mid(sdate1, 1, 4) & "-" & Mid(sdate1, 5, 2) & "-" & Mid(sdate1, 7, 2)
    sdate2 = Mid(sdate2, 1, 4) & "-" & Mid(sdate2, 5, 2) & "-" & Mid(sdate2, 7, 2)
    days = CDate(sdate2) - CDate(sdate1)
    rsttank.Close
    Set rattank = Nothing
    
    avgcost = sumcost / days
    For i = 1 To vasreport.MaxRows
        SetValue vasreport, i, 4, avgcost
    Next
    
End Sub



Private Sub Command1_Click()
Unload Me
End Sub

Private Sub Form_Activate()
    
    DTtime1.SetFocus
End Sub

Private Sub Form_Load()
    
    Call initspread
    Call initcombobox
    vasreport.Lock = True
    'DTtime1.SetFocus
'    cmb_pro.ListIndex = 0
    
End Sub

Private Sub initspread()
 With vasreport
            .MaxRows = 0
            .MaxCols = 4 'enuDetailCols.MaxCols
            .ShadowColor = genuBACKCOLOR.CST_Grid_LostFocus
            .Row = -1: .Col = -1
            .BackColor = genuBACKCOLOR.CST_Grid_LostFocus
            .GridColor = vbBlack
            SetColHead vasreport, 1, "Date", 10
            SetColHead vasreport, 2, "Tank Actual Level", 15
            SetColHead vasreport, 3, "Daily Wastage", 15
            SetColHead vasreport, 4, "Aveage Cost", 15, True
     End With
    
End Sub

Private Sub initcombobox()
Dim sSQL As String
Dim rsttank As Recordset

    sSQL = "select distinct procode,cuscode,tnkcode from iltank where astatus = 'Y'"
    Set rsttank = Acs_cnt.Execute(sSQL)
    cmb_pro.AddItem ("")
    Do While Not rsttank.EOF
    cmb_pro.AddItem (rsttank!procode)
    cmb_cus.AddItem (rsttank!cuscode)
    cmb_tank.AddItem (rsttank!tnkcode)
    rsttank.MoveNext
    Loop
    rsttank.Close
    Set rattank = Nothing
    
End Sub

Private Sub Cmd_exc_Click()

    Call CreateExcelFile
    
End Sub

Private Sub CreateExcelFile()
On Error Resume Next
    Dim n As Integer
    Dim objexcel As Excel.Application
    Dim objwork As Excel.Workbook
    Dim DataArray() As Variant
    ReDim DataArray(vasreport.MaxRows, vasreport.MaxCols)
    
    DataToArray DataArray
    
    Set objexcel = New Excel.Application
    objexcel.Workbooks.Add
    Set objwork = objexcel.ActiveWorkbook
    Set objsheet = objwork.Worksheets(1)
    Set objrange = objwork.ActiveSheet.Range(objwork.ActiveSheet.Cells(2, 1), objwork.ActiveSheet.Cells(vasreport.MaxRows + 1, vasreport.MaxCols))
    objrange.Value = DataArray
    For n = 1 To vasreport.MaxCols
        objrange.Columns(n).AutoFit
    Next n
    
    objwork.ActiveSheet.Range(objwork.ActiveSheet.Cells(2, 1), objwork.ActiveSheet.Cells(vasreport.MaxRows + 1, vasreport.MaxCols)).Select
    objwork.Charts.Add
    objwork.ActiveChart.ApplyCustomType ChartType:=xlBuiltIn, TypeName:="两轴线-柱图"
    objwork.ActiveChart.SetSourceData Source:=Sheets("Sheet1").Range(objwork.ActiveSheet.Cells(2, 1), objwork.ActiveSheet.Cells(vasreport.MaxRows + 1, vasreport.MaxCols)), PlotBy:= _
        xlColumns
    objwork.ActiveChart.SeriesCollection(1).Delete
    objwork.ActiveChart.Location Where:=xlLocationAsNewSheet, name:="Chart"
    With objwork.ActiveChart
        .HasTitle = True
        .ChartTitle.Characters.Text = "Daily Cost"
        .Axes(xlCategory, xlPrimary).HasTitle = False
        .Axes(xlValue, xlPrimary).HasTitle = False
        .Axes(xlCategory, xlSecondary).HasTitle = False
        .Axes(xlValue, xlSecondary).HasTitle = False
    End With
    objwork.ActiveChart.HasDataTable = True
    objwork.ActiveChart.DataTable.ShowLegendKey = False
    objwork.ActiveChart.SeriesCollection(1).Select
    With Selection.Border
        .Weight = xlThin
        .LineStyle = xlAutomatic
    End With
    Selection.Shadow = False
    Selection.InvertIfNegative = False
    With Selection.Interior
        .ColorIndex = 37
        .Pattern = xlSolid
    End With
    With objwork.ActiveChart
        .HasAxis(xlCategory, xlPrimary) = True
        .HasAxis(xlCategory, xlSecondary) = False
        .HasAxis(xlValue, xlPrimary) = True
        .HasAxis(xlValue, xlSecondary) = False
    End With
    objwork.ActiveChart.Axes(xlCategory, xlPrimary).CategoryType = xlCategoryScale
    objwork.ActiveChart.Axes(xlCategory, xlSecondary).CategoryType = xlCategoryScale
    
    objwork.ActiveChart.SeriesCollection(2).Select
    With Selection
        .Weight = xlThin
        .LineStyle = xlAutomatic
        .MarkerForegroundColorIndex = xlAutomatic
        .MarkerStyle = xlNone
        .Smooth = False
        .MarkerSize = 5
        .Shadow = False
    End With
    objwork.ActiveChart.SeriesCollection(1).name = "=""Daily Cost"""
    objwork.ActiveChart.SeriesCollection(2).name = "=""Average"""
    objwork.ActiveChart.Legend.Select
    Selection.Left = 638
    Selection.Top = 135
    Selection.Height = 62
    Selection.AutoScaleFont = False
    With Selection.Font
        .name = "宋体"
        .FontStyle = "常规"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .Background = xlAutomatic
    End With
    
    objwork.ActiveChart.ChartTitle.Select
    Selection.AutoScaleFont = True
    With Selection.Font
        .name = "宋体"
        .Size = 16
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .Background = xlAutomatic
    End With
    objwork.ActiveChart.SeriesCollection(2).Select
    With Selection.Border
        .ColorIndex = 9
        .Weight = xlThin
        .LineStyle = xlContinuous
    End With
    With Selection
        .MarkerBackgroundColorIndex = xlNone
        .MarkerForegroundColorIndex = xlNone
        .MarkerStyle = xlNone
        .Smooth = False
        .MarkerSize = 5
        .Shadow = False
    End With
    objwork.ActiveChart.PlotArea.Select
    With objwork.ActiveChart
        .HasAxis(xlCategory, xlPrimary) = True
        .HasAxis(xlCategory, xlSecondary) = False
        .HasAxis(xlValue, xlPrimary) = True
        .HasAxis(xlValue, xlSecondary) = False
    End With
    objwork.ActiveChart.Axes(xlCategory, xlPrimary).CategoryType = xlAutomatic
    objwork.ActiveChart.Axes(xlCategory, xlSecondary).CategoryType = xlCategoryScale
    objwork.ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowNone, LegendKey:=False
    objwork.ActiveChart.SeriesCollection(1).ApplyDataLabels Type:=xlDataLabelsShowValue, _
    AutoText:=True, LegendKey:=False
    
    objwork.ActiveChart.Axes(xlCategory).Select
    Selection.TickLabels.NumberFormatLinked = False
    Selection.TickLabels.NumberFormatLocal = "m-d"
    objwork.ActiveChart.ChartArea.Select
   
    objexcel.Application.Visible = True
    objexcel.Parent.Windows(1).Visible = True
    
    objexcel.Visible = True
    objexcel.Undo
    
End Sub

Private Sub DataToArray(tmpArray() As Variant)
Dim i, j As Long
Dim tmpData As Variant

    With vasreport
        For i = 1 To .MaxRows
            .Row = i
            For j = 1 To .MaxCols
                .Col = j
                tmpData = .Value
                tmpArray(i, j) = tmpData
            Next j
        Next i
    End With
    
End Sub