datagrid输出到Excel出现问题

[kylinhome]

我datagrid中的内容为
2004-10-11 65253 361722 426975
2004-10-12 62922 357160 420082
2004-10-13 65571 359424 424995
2004-10-14 62163 352999 415162
2004-10-15 66221 356276 422497
2004-10-16 65630 364290 429920
2004-10-17 65625 363058 428683
2004-10-18 66722 323837 421405
2004-10-19 64999 346301 411696
2004-10-20 63276 368765 401987
2004-10-21 61553 391229 392278
2004-10-22 59830 413693 382569
2004-10-23 58107 436157 372860
2004-10-24 56384 458621 363151
2004-10-25 54661 481085 353442
2004-10-26 52938 503549 343733
2004-10-27 51215 526013 334024
2004-10-28 49492 548477 324315
2004-10-29 47769 570941 314606
2004-10-30 46046 593405 304897
2004-10-31 44323 615869 295188
2004-11-1 42600 638333 285479

输出到Excel显示如下，并提示行号出错
2004-10-11 65253 361722 426975
2004-10-12 62922 357160 420082
2004-10-13 65571 359424 424995
2004-10-14 62163 352999 415162
2004-10-15 66221 356276 422497
2004-10-16 65630 364290 429920
2004-10-17 65625 363058 428683
2004-10-18 66722 323837 421405
2004-10-23 64999 346301 411696
2004-11-1
如果有更多的记录，前8个记录正常，往后就开始跳越，每次跳过1＋4天，1＋4＋4天，1+4+4+4天.....


各位高手帮我看看哪里问题
Private Sub Command2_Click()
Dim i As Integer
Dim j As Integer
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)
For i = 0 To DataGrid1.ApproxCount - 1
For j = 0 To DataGrid1.Columns.Count - 1
DataGrid1.Row = i
DataGrid1.Col = j
If IsNull(DataGrid1.Text) = False Then
xlSheet.Cells(i + 1, j + 1) = DataGrid1.Text
End If
Next j
Next i
End Sub

[daisy8675]

isual Basic 导出到 Excel 提速之法


Excel 是一个非常优秀的报表制作软件，用VBA可以控制其生成优秀的报表，本文通过添加查询语句的方法，即用Excel中的获取外部数据的功能将数据很快地从一个查询语句中捕获到EXCEL中,比起往每个CELL里写数据的方法提高许多倍。

将下文加入到一个模块中,屏幕中调用如下ExporToExcel("select * from table")则实现将其导出到EXCEL中

Public Function ExporToExcel(strOpen As String)
'*********************************************************
'* 名称：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 = Nothing

End Function


注:须在程序中引用'Microsoft Excel 9.0 Object Library'和ADO对象,机器必装Excel 2000

本程序在Windows 98/2000,VB 6 下运行通过。

//先给你介绍下这样的方法，这个方法是李红根写的，非常不错

[tztz520]

你先显示出来,看对不对.


For i = 0 To DataGrid1.ApproxCount - 1
For j = 0 To DataGrid1.Columns.Count - 1
DataGrid1.Row = i
DataGrid1.Col = j
If IsNull(DataGrid1.Text) = False Then
debug.print DataGrid1.Text'打印出来
End If
Next j
Next i

[kylinhome]

打印出来和输出的结果一样

[inbreak]

Private Sub Command13_Click() '导出datagrid数据到EXCEL
On Error GoTo ERR

msg = MsgBox("导出当前显示数据到Excel中,是否继续？", vbOKCancel, "数据导出")
If msg = vbCancel Then Exit Sub

Dim txt As String


If DataGrid1.ApproxCount < 1 Then MsgBox "没有数据可导出!": Exit Sub
Dim i As Integer '行
Dim j As Integer '列
Dim k As Integer '列标头
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet

Screen.MousePointer = 11 '将鼠标变成忙
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)
xlSheet.Columns.AutoFit

xlSheet.Cells(1, Int(DataGrid1.Columns.count / 2)) = DataGrid1.Caption 'datagrid标题
For k = 0 To DataGrid1.Columns.count - 1 'DataGrid所有的列数
xlSheet.Cells(2, k + 1) = DataGrid1.Columns(k).Caption '第二行为DataGrid的列标题

Next
DataGrid1.Scroll 0, -DataGrid1.FirstRow '导出前拉动过垂直滚动条
DataGrid1.Row = 0
For i = 0 To DataGrid1.ApproxCount - 1 'DataGrid的所有行数
For k = 0 To DataGrid1.Columns.count - 1 'DataGrid所有的列数,若将此数改小到不拉DataGrid的垂直滚动条的时候能看见的行数的时候正常
DataGrid1.Col = k
If Left(DataGrid1.Text, 1) = 0 Then
txt = ","
Else
txt = ""
End If
xlSheet.Cells(i + 3, k + 1) = txt & DataGrid1.Text '从第三行显示'DataGrid的内容
Next
If i < DataGrid1.ApproxCount - 1 Then
DataGrid1.Row = DataGrid1.Row + 1
End If
Next

Screen.MousePointer = 0
'xlApp.Visible = True
Set xlApp = Nothing '交还控制给Excel
Set xlBook = Nothing
Set xlSheet = Nothing




Exit Sub
ERR:
MsgBox "代码:" & ERR & Chr(10) + Chr(13) & "信息:" & ERROR, vbOKOnly, "错误信息"
Screen.MousePointer = 0
End Sub

[Gujianda]

我帮你试试没有这个问题啊！
不要用 DataGrid 控件，尤其是要在程序中操作它的时候，控制不灵！
原因我也说不大清楚，MSDN 里有说明。
建议改用 FlexGrid 控件，它的可控性比较好，你的程序改用它后这样：

For i = 0 To FlexGrid1.Rows - 1 '.ApproxCount - 1
For j = 0 To FlexGrid1.Cols - 1 '.Columns.Count - 1
FlexGrid1.Row = i
FlexGrid1.Col = j
If IsNull(FlexGrid1.Text) = False Then
xlSheet.Cells(i + 1, j + 1) = FlexGrid1.Text
End If
Next j
Next i