'导入EXEL表
Dim j As Integer
Dim k As Integer
Dim s1 As Double
Dim s2 As Double
With eg1
.Cols = 6
.TextMatrix(0, 1) = "会员ID号"
.TextMatrix(0, 2) = "手机号码"
.TextMatrix(0, 3) = "通话总时长(分钟)"
.TextMatrix(0, 4) = "工资总数(元)"
.TextMatrix(0, 5) = "开始时间"
.TextMatrix(0, 6) = "结束时间"
.FixedRows = 1
End With
Set RsMX = New ADODB.Recordset
RsMX.Open "select * from Attend_GZ", ConnTemp, 2, 3
If RsMX.RecordCount < 1 Then
MsgBox "没有查询到相应信息!", vbOKOnly + vbExclamation, "查询"
Exit Sub
End If
If RsMX.EOF = False Then
With eg1 .Rows = 1
Do While Not RsMX.EOF
.Rows = .Rows + 1
For i = 1 To RsMX.Fields.Count
.TextMatrix(.Rows - 1, i) = RsMX.Fields(i - 1) Next i
RsMX.MoveNext
Loop
End With
End If
RsMX.Close
With eg1
For j = 1 To eg1.Rows - 1
If .TextMatrix(j, 10) <= Date + 7 And .TextMatrix(j, 11) = False Then
.RowBackColor(j) = &HFF&
End If
Next
End With
With eg1 For k = 1 To .Rows - 1
s1 = Val(.TextMatrix(k, 6)) + s1
s2 = Val(.TextMatrix(k, 8)) + s2 Next
.Rows = .Rows + 1
.TextMatrix(.Rows - 1, 0) = "合计"
.TextMatrix(.Rows - 1, 6) = s1
.TextMatrix(.Rows - 1, 8) = s2
End With
运行时提示错误“eg1要求对象”eg1是空,这是为什么啊?谢谢了,各位高手。
Dim j As Integer
Dim k As Integer
Dim s1 As Double
Dim s2 As Double
With eg1
.Cols = 6
.TextMatrix(0, 1) = "会员ID号"
.TextMatrix(0, 2) = "手机号码"
.TextMatrix(0, 3) = "通话总时长(分钟)"
.TextMatrix(0, 4) = "工资总数(元)"
.TextMatrix(0, 5) = "开始时间"
.TextMatrix(0, 6) = "结束时间"
.FixedRows = 1
End With
Set RsMX = New ADODB.Recordset
RsMX.Open "select * from Attend_GZ", ConnTemp, 2, 3
If RsMX.RecordCount < 1 Then
MsgBox "没有查询到相应信息!", vbOKOnly + vbExclamation, "查询"
Exit Sub
End If
If RsMX.EOF = False Then
With eg1 .Rows = 1
Do While Not RsMX.EOF
.Rows = .Rows + 1
For i = 1 To RsMX.Fields.Count
.TextMatrix(.Rows - 1, i) = RsMX.Fields(i - 1) Next i
RsMX.MoveNext
Loop
End With
End If
RsMX.Close
With eg1
For j = 1 To eg1.Rows - 1
If .TextMatrix(j, 10) <= Date + 7 And .TextMatrix(j, 11) = False Then
.RowBackColor(j) = &HFF&
End If
Next
End With
With eg1 For k = 1 To .Rows - 1
s1 = Val(.TextMatrix(k, 6)) + s1
s2 = Val(.TextMatrix(k, 8)) + s2 Next
.Rows = .Rows + 1
.TextMatrix(.Rows - 1, 0) = "合计"
.TextMatrix(.Rows - 1, 6) = s1
.TextMatrix(.Rows - 1, 8) = s2
End With
运行时提示错误“eg1要求对象”eg1是空,这是为什么啊?谢谢了,各位高手。
Dim WrkXls As Excel.Workbook
研究一下Excel.Application 和 Excel.Workbook
'*********************************************************
'* 名称:ExporToExcel
'* 功能:导出数据到EXCEL
'* 用法:ExporToExcel(sql查询字符串)
'*********************************************************
Dim Rs_Data As New ADODB.Recordset
Dim Irowcount As Integer
Dim Icolcount As Integer
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 = Cn
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = adLockReadOnly
.Source = strOpen
.Open
End With
With Rs_Data
If .RecordCount < 1 Then
MsgBox ("没有记录!")
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")
xlApp.Visible = True
'添加查询语句,导入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
With xlSheet
.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
'设表格边框样式
End With
With xlSheet.PageSetup
.LeftHeader = "" & Chr(10) & "&""楷体_GB2312,常规""&10公司名称:" ' & Gsmc
.CenterHeader = "&""楷体_GB2312,常规""公司人员情况表&""宋体,常规""" & Chr(10) & "&""楷体_GB2312,常规""&10日 期:"
.RightHeader = "" & Chr(10) & "&""楷体_GB2312,常规""&10单位:"
.LeftFooter = "&""楷体_GB2312,常规""&10制表人:"
.CenterFooter = "&""楷体_GB2312,常规""&10制表日期:"
.RightFooter = "&""楷体_GB2312,常规""&10第&P页 共&N页"
End With
xlApp.Application.Visible = True
Set xlApp = Nothing '"交还控制给Excel
Set xlBook = Nothing
Set xlSheet = NothingEnd Function
注:须在程序中引用'Microsoft Excel 9.0 Object Library'和ADO对象,机器必装Excel 2000本程序在Windows 98/2000,VB 6 下运行通过。
这是比较快的方法