10-09-15, 08:34 PM
(آخر تعديل لهذه المشاركة : 10-09-15, 08:34 PM {2} بواسطة ابومحمد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 'ورقة العمل
الرموز الغير واضحه هذي تعريفات الكود ووضائفها باللغه العربيه
الاخوة الكرام
اسعد الله مساكم
سوف ارفق لكم كود وهو عباره عن استخراج البيانات من قاعدة بيانات اكسس وتفريغها في ملف اكسل وحيث انني اوجه صعوبه في ذلك فاريد ممن يجد في نفسة القدره علي تعديل الكود وتجربته اكون شاكر ومقدر له
ما اواجهه في الكود :
ان العملية يقوم بسحب عدة بيانات وليس كلها
ان العملية يوجد فيها تكرار للسجلات
ان العملية تقوم بسحب البيانات من الاكسس مباشره والمطلوب يسحبها من الداتا جريد واحدد البيانات التي اريد ان تخرج في الاكسل
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 'ورقة العمل
الرموز الغير واضحه هذي تعريفات الكود ووضائفها باللغه العربيه