[alaa_altunsi]

السلام عليكم
بحثت قبل فترة عن هذا السؤال و وصلت لطريقة وهي وضع ملف اكسل كامل التصميم بمسار تطبيقي ثم تصدير جدول قاعدة البيانات لذلك الصميم بعد نسخه كما في الكود
الاتي
ملاحظة: قمت بتقليل حجم الكود قدر المستطاع وأي سؤال اني حاضر

Xy = App.Path
FileCopy Xy + "s.xlsx", CommonDialog1.FileName (هنا القالب الذي صممته مسبقا ليتم نسخه اولا للهدف الذي يخزن حسب رغبة المستخدم )

Dim objExcel As Excel.Application

Set objExcel = New Excel.Application

objExcel.Workbooks.Open CommonDialog1.FileName
objExcel.Worksheets("Sheet1").Activate

rs.Open "select * from em order by ID", connect, adOpenDynamic, adLockOptimistic
(هنا سيتم تصدير الحقول للاكسل)
Do While Not rs.EOF
objExcel.Cells(i + 1, 1).Value = i
objExcel.Cells(i + 1, 2).Value = rs.Fields!Nam
objExcel.Cells(i + 1, 3).Value = rs.Fields!empl
objExcel.Cells(i + 1, 4).Value = rs.Fields!Clas
objExcel.Cells(i + 1, 5).Value = rs.Fields!YearDate
objExcel.Cells(i + 1, 6).Value = rs.Fields!Marrige
objExcel.Cells(i + 1, 7).Value = rs.Fields!Children
objExcel.Cells(i + 1, 8).Value = rs.Fields!pric
objExcel.Cells(i + 1, 9).Value = rs.Fields!date1
objExcel.Cells(i + 1, 10).Value = rs.Fields!date2
objExcel.Cells(i + 1, 11).Value = rs.Fields!Mobile
objExcel.Cells(i + 1, 12).Value = rs.Fields!Ad
objExcel.Cells(i + 1, 13).Value = rs.Fields!State
rs.MoveNext
Loop
rs.Close
objExcel.ActiveWorkbook.Save
objExcel.Quit
Set objExcel = Nothing