.....
rs.open "select 使用量 from x where format(日期,'yyyymmddhh')='2014070700'",conn,1,1
s=rs(0)
rs.close
rs.open "select 使用量 from x where format(日期,'yyyymmddhh')='2014070800'",conn,1,1
s=rs(0)-s
rs.close
MsgBox "7月7日当天0-24点的燃煤总累计使用量为" &s &"吨"
可以快速导出使用excel 就有该功能
Public Function ExportToExcel(ByVal strOpen As String, Title As String, dizhi As String, con As ADODB.Connection)'*********************************************************
'* 名称:ExporToExcel
'* 功能:导出数据到EXCEL'* 用法:ExporToExcel(strOpen查询字符串,titile
'*excel标题,dizhi 保存路径,con 数据库连接地址)
'*********************************************************
lok: On Error GoTo er
Screen.MousePointer = 11
Dim Rs_Data As New ADODB.Recordset
Dim Irowcount As Long
Dim Icolcount As Long
Dim XlApp As New Excel.Application
Dim xlbook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim xlQuery As Excel.QueryTable
With Rs_Data
If .State = adStateOpen Then
.Close
End If
.ActiveConnection = con
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = adLockReadOnly
.Source = strOpen
DoEvents
' Debug.Print strOpen
.Open
End With
Debug.Print strOpen
' Set Rs_Data = Open_rst_from_str(strOpen)
With Rs_Data
If .RecordCount < 1 Then
MsgBox ("没有记录!")
Screen.MousePointer = 0
Exit Function
End If
'记录总数
Irowcount = .RecordCount
'字段总数
Icolcount = .Fields.Count
End With
Set XlApp = CreateObject("Excel.Application")
Set xlbook = Nothing
Set xlSheet = Nothing
Set xlbook = XlApp.Workbooks().Add
Set xlSheet = xlbook.Worksheets("sheet1")
'添加查询语句,导入EXCEL数据
Set xlQuery = xlSheet.QueryTables.Add(Rs_Data, xlSheet.Range("a1"))
With xlQuery
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
End With
xlQuery.FieldNames = True '显示字段名
xlQuery.Refresh
Dim i As Integer, Zd As String
With xlSheet
For i = 1 To 6
Zd = .Range(.Cells(1, 1), .Cells(1, Icolcount)).item(1, i)
' .Range(.Cells(1, 1), .Cells(1, Icolcount)).Item(1, i) = Lm_YwToZw(Zd)
Next
.Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.name = "黑体"
'设标题为黑体字
' .Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.Bold = True
'标题字体加粗
.Range(.Cells(1, 1), .Cells(Irowcount + 1, Icolcount)).Borders.LineStyle = xlContinuous
' .Range(.Cells(Irowcount + 2, Icolcount)).Text = Zje
'设表格边框样式
End With
XlApp.Visible = True
XlApp.Application.Visible = True
' xlBook.SaveAs dizhi
Set XlApp = Nothing '"交还控制给Excel
Set xlbook = Nothing
Set xlSheet = Nothing
Screen.MousePointer = 0
Exit Function
er:
' Dispose_Err
MsgBox err.Description & " 从新导报表,请等待!"
GoTo lok:
End Function
使用这个模块就可以,你可以看看引用的函数即可
欢迎分享,转载请注明来源:内存溢出
评论列表(0条)