یک مشکل کوچیک در اکسس

[Nader700]

سلام به همگی
من با استفاده از کد زیر میتونم از یک فرم سینگل در اکسس خروجی اکسل بگیرم . اما مشکل من اینه که همه داده ها رو به اکسل منتقل میکنه
من میخوام همون رکورد جاری که دارم می بینم رو برام خروجی اکسل بگیره
دوستان لطفا راهنمایی کنید . در ضمن من مبتدی هستم خواهشا کامل توضیح بدین ممنون میشم

Public Function Send2Excel6(frm As Form, Optional strSheetName As String)


Dim rst As DAO.Recordset
Dim ApXL As Object
Dim xlWBk As Object
Dim xlWSh As Object
Dim intCount As Long
Const xlCenter As Long = -4108
Const xlBottom As Long = -4107

On Error GoTo err_handler

Set rst = frm.RecordsetClone

Set ApXL = CreateObject("Excel.Application")
Set xlWBk = ApXL.Workbooks.add
ApXL.Visible = True

Set xlWSh = xlWBk.Worksheets("Sheet1")
If Len(strSheetName) > 0 Then
xlWSh.Name = Left(strSheetName, 34)
End If
xlWSh.Range("A1").Select
Do Until intCount = rst.Fields.Count
ApXL.ActiveCell = rst.Fields(intCount).Name
ApXL.ActiveCell.Offset(0, 1).Select
intCount = intCount + 1
Loop

rst.MoveFirst
xlWSh.Range("A2").CopyFromRecordset rst
xlWSh.Range("A:C").Select

With ApXL.Selection.Font
.Name = "iransans"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
End With
xlWSh.Range("A1:C1").Select
ApXL.Selection.Font.Bold = True
With ApXL.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With

xlWSh.Range("A1").Select
xlWSh.Range("A1").Value = "name"
xlWSh.Range("B1").Value = "lastName"
xlWSh.Range("C1").Value = "kodmli"


ApXL.ActiveSheet.Cells.Select

ApXL.ActiveSheet.Cells.EntireColumn.AutoFit

xlWSh.Range("A1").Select

rst.Close
Set rst = Nothing

Exit Function
err_handler:
DoCmd.SetWarnings True
MsgBox Err.Description, vbExclamation, Err.Number
Exit Function

End Function

[Nader700]

سلام به همه دوستان
کسی نبود ما رو راهنمایی کنه؟؟؟؟