[ابومحمد1979]

السلام عليكم ورحمة الله وبركاته

الاخوة الكرام

اسعد الله مساكم

سوف ارفق لكم كود وهو عباره عن استخراج البيانات من قاعدة بيانات اكسس وتفريغها في ملف اكسل وحيث انني اوجه صعوبه في ذلك فاريد ممن يجد في نفسة القدره علي تعديل الكود وتجربته اكون شاكر ومقدر له

ما اواجهه في الكود :

ان العملية يقوم بسحب عدة بيانات وليس كلها
ان العملية يوجد فيها تكرار للسجلات
ان العملية تقوم بسحب البيانات من الاكسس مباشره والمطلوب يسحبها من الداتا جريد واحدد البيانات التي اريد ان تخرج في الاكسل





code :


زر الحدث

Private Sub Command1_Click()
'On Error Resume Next
'Set rs = New ADODB.Recordset
Set DataGrid1.DataSource = rs
rs.Open "SELECT * FROM Infractions ORDER BY contract", cn, adOpenStatic, adLockOptimistic
If rs.RecordCount <= 0 Then
   MsgBox "áÇ ÊæÌÏ ÈíÇäÇÊ Ýí ÇáÞÇÚÏÉ ÇáÈíÇäÇÊ"
Else
       
 
   CommonDialog1.CancelError = True
   On Error GoTo ErrHandler
   
  'CommonDialog1.Filter = "Excel files: ( *.xls ) |*.xls|"
  'CommonDialog1.FileName = "Book1"
  'CommonDialog1.ShowSave
   
 '  If CommonDialog1.FileName = "" Then Exit Sub
   Set xlApp = CreateObject("Excel.Application")
   xlApp.SheetsInNewWorkbook = 1
   xlApp.Visible = True
   Set xlBook = xlApp.Workbooks.Add
   xlApp.Windows(1).ActiveSheet.Name = "sheet"
   
   'ÍÝÙ ãáÝ ÇßÓá
  'xlBook.SaveAs FileName:=CommonDialog1.FileName
   
   
   Set xlSheet = xlBook.Worksheets("Sheet")
   
   'áÕÞ ÇáÈíÇäÇÊ ãä ÇáÞÇÚÏÉ ÇáÈíÇäÇÊ Çáì ãáÝ ÇßÓá
       xlSheet.Range("B6").CopyFromRecordset rs
   'ØÈÇÚÉ ÊÇÑíÎ Çáíæã
    xlSheet.Cells(3, 3).Value = Date
    xlSheet.Cells(3, 1).Value = "Report printed "


   'ÊÛííÑ ÚÑÖ ÇáÚãæÏ
   xlSheet.Cells(5, 2).ColumnWidth = 5
   xlSheet.Cells(5, 1).ColumnWidth = 5
   'xlSheet.cells(3, 2).Value = "ÊÞÑíÑ ÌÇåÒíÉ ÇáÚãá"

   'ØÈÇÚÉ ÞíãÉ Ýí ÇáÎáíÉ
   xlSheet.Cells(5, 1).Value = "Ê"
   xlSheet.Cells(5, 1).ColumnWidth = 3
     
   xlSheet.Cells(5, 2).ColumnWidth = 10
   xlSheet.Cells(5, 2).Value = "ÇáÔÑßå ÇáãäÝÐå"
   
   xlSheet.Cells(5, 3).ColumnWidth = 10
   xlSheet.Cells(5, 3).Value = "äæÚ ÇáãÎÇáÝå"
   
   xlSheet.Cells(5, 4).ColumnWidth = 14
   xlSheet.Cells(5, 4).Value = "ÊÝÇÕíá ÇáãÎÇáÝå"
   
   xlSheet.Cells(5, 5).ColumnWidth = 10
   xlSheet.Cells(5, 5).Value = "ÑÞã ÇãÑ ÇáÚãá"
   
   xlSheet.Cells(5, 6).ColumnWidth = 10
   xlSheet.Cells(5, 6).Value = "ÇáßÈíäå"
   
   xlSheet.Cells(5, 7).ColumnWidth = 10
   xlSheet.Cells(5, 7).Value = "ÇáãÏíäå"
   
   xlSheet.Cells(5, 8).ColumnWidth = 10
   xlSheet.Cells(5, 8).Value = "ÇáãÔÑÝ / ãÞÇæá"
   
   xlSheet.Cells(5, 9).ColumnWidth = 10
   xlSheet.Cells(5, 9).Value = "ÇáãÝÊÔ"
   
   xlSheet.Cells(5, 10).ColumnWidth = 10
   xlSheet.Cells(5, 10).Value = "ÊÇÑíÎ ÊÓÌíá ÇáãÎÇáÝå"
   
   xlSheet.Cells(5, 11).ColumnWidth = 10
   xlSheet.Cells(5, 11).Value = "ÑÞã ÇáßÈíäå"


   xlSheet.Range("a5:z5").Font.Bold = True
   
   'ØÈÇÚÉ ÞíãÉ 1 æ2  Êã ÊÚÈÆÉ ÈÇÞÓ ÇáÍÞæá ÊáÞÇÆíÇð
   xlSheet.Cells(6, 1).Value = 1
   xlSheet.Cells(7, 1).Value = 2
   
   xlSheet.Range("a6:AB").AutoFill Destination:=xlSheet.Range("a6:B" & rs.RecordCount + 5), Type:=xlLinearTrend

   'Êßæíä ÍÏæÏ ÇáÌÏæá
   xlSheet.Range("a5:AB" & rs.RecordCount + 5).Borders.Weight = xlThin
   'ÊäÓíÞ ÍÌã ÇáÎØ
   xlSheet.Range("a5:AB" & rs.RecordCount + 7).Font.Size = 10
     'ÊäÓíÞ áæä ÇáÎáíå
   xlSheet.Range("a5:AB" & rs.RecordCount + 7).Font.Color = &H404080

   'ÊäÓíÞ äæÚ ÇáÎØ
   xlSheet.Range("a5:AB" & rs.RecordCount + 7).Font.Name = "Times New Roman"
   'ÊäÓíÞ ÇáÍÇÐÇÉ ÇáÇÝÞíÉ ááÎáíÉ
   xlSheet.Range("a5:AB" & rs.RecordCount + 7).HorizontalAlignment = xlCenter
   'ÊäÓíÞ ÇáÍÇÐÇÉ ÇáÚãæÏíÉ ááÎáíÉ
   xlSheet.Range("a5:AB" & rs.RecordCount + 7).VerticalAlignment = xlVAlignCenter
   
   'ÇáßÊÇÈÉ ÖíÛÉ ÑíÇÖíÉ Ýí ÎáíÉ
   'xlSheet.Range("F6").Formula = "=D6*E6"
   'ÊÚÈÆÉ ÇáÕíÛÉ ÇáÑíÇÖíÉ Ýí ÈÇÞí ÇáÎáíÇ ÇáãÍÏÏÉ
  ' xlSheet.Range("F6").AutoFill Destination:=xlSheet.Range("F6:F" & rs.RecordCount + 5), Type:=xlGrowthTrend
   
  ' xlSheet.Range("E" & rs.RecordCount + 7).Value = "ÇáãÌãæÚ Çáßáí"
   'ßÊÇÈÉ ÕíÛÉ ÑíÇÖÉ áÍÓÇÈ ÇáãÌãæÚ Çáßáí
   'xlSheet.Range("F" & rs.RecordCount + 7).Formula = "=SUM(F6:F" & rs.RecordCount + 5 & ")"
   'ÊäÓíÞ ØÑíÞÉ ÚÑÖ ÇáÇÑÞÇã
   xlSheet.Range("F" & rs.RecordCount + 7).NumberFormat = "###,##0.00"
   xlSheet.Range("E" & rs.RecordCount + 7 & ":F" & rs.RecordCount + 7).Font.Bold = True
   xlSheet.Range("E" & rs.RecordCount + 7 & ":F" & rs.RecordCount + 7).Borders.Weight = xlThin
 '  xlSheet.cells.Interior.Color = 0
   
   
   'ÇÞÝÇá ÇáãáÝ ãÚ ÍÝÙ ÇáÊÚÏíáÇÊ
 '  xlBook.Close saveChanges:=True
 '  xlApp.Quit
 '  Set xlSheet = Nothing
 '  Set xlBook = Nothing
 '  Set xlApp = Nothing
End If

ErrHandler:
' User pressed Cancel button.
  Exit Sub

End Sub


التصريح العام :

Public cn  As New ADODB.Connection
Dim WithEvents rs1 As Recordset
Public rs As New ADODB.Recordset
Public xlApp As Excel.Application
Public xlBook As Excel.Workbook 'المصنف
Public xlSheet As Excel.Worksheet   'ورقة العمل

---

الرموز الغير واضحه هذي تعريفات الكود ووضائفها باللغه العربيه