تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
ارجوا مساعدتي في تحليل وتعديل الكود
#1
السلام عليكم ورحمة الله وبركاته

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

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

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

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

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






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   'ورقة العمل

الرموز الغير واضحه هذي تعريفات الكود ووضائفها باللغه العربيه
الرد }}}}
تم الشكر بواسطة:
#2
مرحبا محمد
اود القول اخي الفاضل ما هكذا تورد الابل يا عكرمة
اعمل مثال بسيطة ااربع قاعدة بيانات حط الادوات على الفورم
شغله المشروع صور المشكلة مثلا
وارفق المثال في المشاركة
هكذا لم تعد عليك حجة
اما كود اشبه ما يكون لبرنامج كامل
مرهق جدا على من سيحاول المساعدة يا صديقي
بالتوفيق
سبحان الله والحمدلله ولا إله إلا الله والله أكبر
 رَبِّ اغْفِرْ لِي وَلِوَالِدَيَّ
Heart
الرد }}}}
تم الشكر بواسطة: Ahmed_Mansoor , Ahmed_Mansoor , الطالب , starwarr2005
#3
تسلم يالغالي وضعت شرح المشكله علي اليوتيوب واتمنى ان تكون الصوره واضحه والكود تجدونه في مشاركتي الاولي

تحياتي ،،،

رابط شرح مشكلت الكود علي اليوتيوب
الرد }}}}
تم الشكر بواسطة: الطالب
#4
شوف
مشكلتك في جملة الاتسعلام اللي تستخدمها تحت البوتون اللي يرسل البيانات الى شيت الاكسل
خلي جملة الاستعلام هي نفسها اللى اظهرت لك تفاصيل المخالفات
هذا الحل يا كابتن
ثم اني ملاحظ انك لما ضغط لارسال البيانات للاكسل اختفت من شبكة عرض البيانات
سبحان الله والحمدلله ولا إله إلا الله والله أكبر
 رَبِّ اغْفِرْ لِي وَلِوَالِدَيَّ
Heart
الرد }}}}
تم الشكر بواسطة: الطالب , ابومحمد1979
#5
السلا م عليكم

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

يعطيك العافية
شـــايـفـــك

الرد }}}}
تم الشكر بواسطة: الطالب , أبو عمر , ابومحمد1979
#6
جزاكم الله خير فردا فردا ورزقكم صحة الابدان وطول العمر علي الطاعه سوف ارسل المشروع باذن الله هذا اليوم

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

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


لقد تم وضع شرح للمشكله بشكل ادق وتم رفعها علي اليوتيوب ولمشاهدة ذلك قم بزيارة الصفحة

https://youtu.be/YO-uTr7PMKk



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

تحميل المشروع هنا
الرد }}}}
تم الشكر بواسطة:
#7
مرحبا ابو محمد 
للاسف لم استطع تجربة المشروع لان به ادوات ليست في الجهاز 
لكن نفذ اللي في الصور ورد لي خبر



سبحان الله والحمدلله ولا إله إلا الله والله أكبر
 رَبِّ اغْفِرْ لِي وَلِوَالِدَيَّ
Heart
الرد }}}}
تم الشكر بواسطة: Ahmed_Mansoor , Ahmed_Mansoor
#8
(11-09-15, 10:16 PM)أبو عمر كتب : مرحبا ابو محمد 
للاسف لم استطع تجربة المشروع لان به ادوات ليست في الجهاز 
لكن نفذ اللي في الصور ورد لي خبر




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

والامر الاخر ابي ترقيم تلقائي يعني اذا عشر او عشرين او 100 سجل يرقمها تسلسلي

الرد }}}}
تم الشكر بواسطة:
#9
دوس debog
وهات صورة
سبحان الله والحمدلله ولا إله إلا الله والله أكبر
 رَبِّ اغْفِرْ لِي وَلِوَالِدَيَّ
Heart
الرد }}}}
تم الشكر بواسطة:
#10
علي رابط اليوتيوب

والله اشغلتكم معي جعل الفدروس نزلكم ووالدينا ووالديكم


https://youtu.be/mkplOIPro7U
الرد }}}}
تم الشكر بواسطة:


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  [vb6.0] ارجو المساعدة والتعديل في هدا الكود عمور2016 2 161 10-07-16, 12:15 PM
آخر رد: عمور2016
  ارجوا برنامج للتحزيم hisoma 3 374 05-06-16, 09:53 AM
آخر رد: aboezzat84
  [vb6.0] اخواني الاعزاء ارجوا المساعدة في هذا المشروع corex 2 280 08-05-16, 12:36 AM
آخر رد: corex
  ارجوا المساعدة في كتابة كود adel_3812 2 316 16-01-16, 12:24 AM
آخر رد: hamada salah90
  ارجوا المساعدة عن تكرار الارقام hisoma 6 518 31-12-15, 02:35 AM
آخر رد: ahmedabdelaliem
  [vb6.0] طلب : نسخ قاعدة البيانات gg.mdb التي نتنسيق 97 وتحويلها إلى تنسيق 2003 بواسطة الكود hamada salah90 3 274 05-11-15, 08:12 PM
آخر رد: hamada salah90
  [vb6.0] طلب: إضافة نص من الفيجول بيسك إلى Word وإنشاء جدول بواسطة الكود hamada salah90 1 626 19-07-15, 01:03 AM
آخر رد: Ahmed_Mansoor
  تصدير البيانات الي ملف اكسل .. ارجوا مساعدتكم ابومحمد1979 2 588 17-02-15, 01:11 AM
آخر رد: ابومحمد1979
  أرجو مساعدتي لحل هذه المشكلة fady013 2 494 21-12-14, 08:28 PM
آخر رد: Amir_alzubidy
  [vb6.0] ما هى المشكله فى هذا الكود ؟ aboezzat84 0 292 14-12-14, 12:18 AM
آخر رد: aboezzat84

التنقل السريع :


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم