وعليكم السلام ورحمة الله وبركاته...
Sub ExportToExcel()
Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object
Dim rs As DAO.Recordset
Dim i As Integer
Dim j As Integer
' افتح تطبيق إكسل
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)
' افتح سجل البيانات (Recordset) الذي تريد تصديره
Set rs = CurrentDb.OpenRecordset("اسم_الجدول_أو_الاستعلام")
' تصدير العناوين
For i = 0 To rs.Fields.Count - 1
xlSheet.Cells(1, i + 1).Value = rs.Fields(i).Name
Next i
' تصدير البيانات
rs.MoveFirst
i = 2
Do While Not rs.EOF
For j = 0 To rs.Fields.Count - 1
xlSheet.Cells(i, j + 1).Value = rs(j)
Next j
i = i + 1
rs.MoveNext
Loop
' تنسيق العناوين
With xlSheet.Rows(1)
.Font.Bold = True
.Font.Size = 16
.Interior.Color = RGB(255, 255, 0) ' خلفية صفراء
.HorizontalAlignment = -4108 ' توسيط النص
End With
' تنسيق البيانات
With xlSheet.Range(xlSheet.Cells(2, 1), xlSheet.Cells(i - 1, rs.Fields.Count))
.Font.Size = 14
.Font.Bold = True
.HorizontalAlignment = -4108 ' توسيط النص
End With
' توسيع الأعمدة لتلائم المحتوى
xlSheet.Columns.AutoFit
' عرض تطبيق إكسل
xlApp.Visible = True
' تنظيف الذاكرة
Set rs = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
End Sub