|
下面代码我测试过了,可行。在子窗体中选择记录,在主窗体的一个标签上单击。
Private Sub Label2_Click()
With Me.Xzc.Form '子表单subMC
If .SelHeight > 0 Then
Dim intStartR As Integer '定义用户选择的开始记录号
Dim intEndR As Integer '定义用户选择的结束记录号
Dim intRows As Integer '定义用户选择的行数
Dim dbs As New adodb.Connection
Dim rst1 As New adodb.Recordset ' 电子表格记录集
Dim rst As dao.Recordset '定义当前记录集
Dim arrGetR As Variant, x As Integer, y As Integer '定义记录集数组,上标和下标
Dim intFieldCount As Integer '定义并获取当前记录集的字段数量
Dim sName As String, st1 As String
Set rst = .RecordsetClone
intFieldCount = rst.Fields.Count
intStartR = .CurrentRecord
intEndR = .SelTop + .SelHeight
intRows = intEndR - intStartR '获取用户选择的记录,注意的是用户必须从上而下选择记录,而不能从下而上选择记录
arrGetR = rst.GetRows(intRows) ', .Bookmark) '获取记录集的指定行数
sName = "c:\tmpOpt.xls" ' 表格路径名称
' 获取子窗体数据源 如果数据源是SQL语句,后面有分号,改了一下,去掉分号
st1 = Trim(.RecordSource)
If Right(st1, 1) = ";" Then st1 = Left(st1, Len(st1) - 1)
st1 = "(Select * From (" & st1 & ") Where False)"
' 建立并打开电子表格
CurrentDb.Execute "SELECT * INTO [Excel 8.0;DATABASE=" & sName & "].Sheet1 FROM " & st1
dbs.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sName & ";Extended Properties=""Excel 8.0;"""
rst1.Open "Select * from [Sheet1$]", dbs, adOpenForwardOnly, adLockOptimistic
'=================================================================循环输出记录
For x = 0 To intRows - 1
rst1.AddNew
For y = 0 To intFieldCount - 1
rst1.Fields(y) = arrGetR(y, x)
Next y
rst1.Update
Next x
'=================================================================循环输出记录
End If
End With
End Sub
[ 本帖最后由 t小宝 于 2008-3-12 00:12 编辑 ] |
|