泰迪冬天怕冷吗:在VB程序中插入一个EXCEL对象后,该怎么向里面写数据,有没有办法在把它和DATA控件绑定在一起

Private Sub Command1_Click()
Dim Irow, Icol As Integer
Dim Irowcount, Icolcount As Integer
Dim Fieldlen() '"存字段长度值
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)
With Data1
.Recordset.MoveLast
If .Recordset.RecordCount < 1 Then
MsgBox ("Error 没有记录!")
Exit Sub
End If
Irowcount = .Recordset.RecordCount '"记录总数
Icolcount = .Recordset.Fields.Count '"字段总数
ReDim Fieldlen(Icolcount)
.Recordset.MoveFirst
For Irow = 1 To Irowcount + 1
For Icol = 1 To Icolcount
Select Case Irow
Case 1 '"在Excel中的第一行加标题
xlSheet.Cells(Irow, Icol).Value = .Recordset.Fields(Icol - 1).Name
Case 2 '"将数组FIELDLEN()存为第一条记录的字段长

If IsNull(.Recordset.Fields(Icol - 1)) = True Then
Fieldlen(Icol) = LenB(.Recordset.Fields(Icol - 1).Name)
' "如果字段值为NULL,则将数组Filelen(Icol)的值设为标题名的宽度
Else
Fieldlen(Icol) = LenB(.Recordset.Fields(Icol - 1))
End If

xlSheet.Columns(Icol).ColumnWidth = Fieldlen(Icol)
' "Excel列宽等于字段长
xlSheet.Cells(Irow, Icol).Value = .Recordset.Fields(Icol - 1)
'"向Excel的CellS中写入字段值
Case Else
Fieldlen1 = LenB(.Recordset.Fields(Icol - 1))

If Fieldlen(Icol) < Fieldlen1 Then
xlSheet.Columns(Icol).ColumnWidth = Fieldlen1
'"表格列宽等于较长字段长
Fieldlen(Icol) = Fieldlen1
' "数组Fieldlen(Icol)中存放最大字段长度值
Else
xlSheet.Columns(Icol).ColumnWidth = Fieldlen(Icol)
End If

xlSheet.Cells(Irow, Icol).Value = .Recordset.Fields(Icol - 1)
End Select
Next
If Irow <> 1 Then
If Not .Recordset.EOF Then .Recordset.MoveNext
End If
Next
End With
With xlSheet
.Range(.Cells(1, 1), .Cells(1, Icol - 1)).Font.Name = "黑体"
' "设标题为黑体字
.Range(.Cells(1, 1), .Cells(1, Icol - 1)).Font.Bold = True
' "标题字体加粗
.Range(.Cells(1, 1), .Cells(Irow, Icol - 1)).Borders.LineStyle = xlContinuous
'"设表格边框样式
xlApp.Visible = True ' "显示表格
' xlBook.Save "保存"
Set xlApp = Nothing '"交还控制给Excel
End With
End Sub

Private Sub Form_Load()
Data1.DatabaseName = App.Path & "\house.mdb"
Data1.RecordSource = "合同"
Data1.Refresh
End Sub