تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
تصدير البيانات الي ملف اكسل .. ارجوا مساعدتكم
#1
[align=right]بسم الله الرحمن الرحيم

الاخوة الاعزاء اسعد الله مساكم اين ماكنتم  ووفقكم الي الخير

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

إقتباس :Set rs = New ADODB.Recordset
rs.Open "SELECT * FROM actions ORDER BY ordernumber", cn, adOpenStatic, adLockOptimistic
If rs.RecordCount <= 0 Then
   MsgBox "áÇ ÊæÌÏ ÈíÇäÇÊ Ýí ÇáÞÇÚÏÉ ÇáÈíÇäÇÊ"
Else
   
   CommonDialog1.CancelError = True
   On Error GoTo ErrHandler
   
   Set xlApp = CreateObject("Excel.Application")
   xlApp.SheetsInNewWorkbook = 1
   xlApp.Visible = True
   Set xlBook = xlApp.Workbooks.Add
   xlApp.Windows(1).ActiveSheet.Name = "sheet"
   
   
   
   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(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 = "SITE FOC"
   
   xlSheet.cells(5, 9).columnWidth = 10
   xlSheet.cells(5, 9).Value = "RACK"
   
   xlSheet.cells(5, 10).columnWidth = 10
   xlSheet.cells(5, 10).Value = "POSTION"
   
   xlSheet.cells(5, 11).columnWidth = 10
   xlSheet.cells(5, 11).Value = "Fiber"
   
   xlSheet.cells(5, 12).columnWidth = 10
   xlSheet.cells(5, 12).Value = "Capillaries"
   
   xlSheet.cells(5, 13).columnWidth = 10
   xlSheet.cells(5, 13).Value = "NEW_DP"
   
   xlSheet.cells(5, 14).columnWidth = 10
   xlSheet.cells(5, 14).Value = "FIM"
   
   xlSheet.cells(5, 15).columnWidth = 10
   xlSheet.cells(5, 15).Value = "DP"
   
   xlSheet.cells(5, 16).columnWidth = 10
   xlSheet.cells(5, 16).Value = "BSW"
   
   xlSheet.cells(5, 17).columnWidth = 10
   xlSheet.cells(5, 17).Value = "REMARKS"
   
   xlSheet.cells(5, 18).columnWidth = 10
   xlSheet.cells(5, 18).Value = "FOC_Type"
   
   xlSheet.cells(5, 19).columnWidth = 10
   xlSheet.cells(5, 19).Value = "DB_Type"
   
   xlSheet.cells(5, 20).columnWidth = 10
   xlSheet.cells(5, 20).Value = "ÈÏÇíÉ ÇáÚãá"
   
   xlSheet.cells(5, 21).columnWidth = 10
   xlSheet.cells(5, 21).Value = "ÇÞÝÇá ÇáÚãá"
   
   xlSheet.cells(5, 22).columnWidth = 10
   xlSheet.cells(5, 22).Value = "ÇáãÞÇæá"
   
   xlSheet.cells(5, 23).columnWidth = 10
   xlSheet.cells(5, 23).Value = "ÇáãÝÊÔ"
   
   xlSheet.cells(5, 24).columnWidth = 14
   xlSheet.cells(5, 24).Value = "ÊÇÑíÎ ÊÓÌíá ÇáÚãá"
   
   xlSheet.cells(5, 25).columnWidth = 10
   xlSheet.cells(5, 25).Value = "ÍÇáÉ ÇáÚãá"
 
   xlSheet.cells(5, 26).columnWidth = 80
   xlSheet.cells(5, 26).Value = "ãáÇÍÙÇÊ"

   xlSheet.Range("a5:z5").Font.Bold = True
   
   xlSheet.cells(6, 1).Value = 1
   xlSheet.cells(7, 1).Value = 2
   
   xlSheet.Range("a6:B7").AutoFill Destination:=xlSheet.Range("a6:B" & rs.RecordCount + 5), Type:=xlLinearTrend

   xlSheet.Range("a5:z" & rs.RecordCount + 5).Borders.Weight = xlThin
   xlSheet.Range("a5:z" & rs.RecordCount + 7).Font.Size = 10
   xlSheet.Range("a5:z" & rs.RecordCount + 7).Font.Color = &H404080

   xlSheet.Range("a5:z" & rs.RecordCount + 7).Font.Name = "Times New Roman"
   xlSheet.Range("a5:z" & rs.RecordCount + 7).HorizontalAlignment = xlCenter
   xlSheet.Range("a5:z" & rs.RecordCount + 7).VerticalAlignment = xlVAlignCenter
   
   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
End If

ErrHandler:
الرد }}}}
تم الشكر بواسطة:
#2
اخى العزيز

هذا الكود يعمل معى جيدا و استخدمة في كثير من برامجى

أرجوان تجد فيه ما تسأل عنه.

كود :
Private Sub Export_Click()
On Error Resume Next
  Dim Anas As Object
  Dim Abbas As Object
  Dim Eidan As Object
  Set Anas = CreateObject("Excel.Application")
  Set Abbas = Anas.Workbooks.Add
     Dim DataArray(1 To 20000, 1 To 30) As Variant
     Dim r As Integer
     Dim NumberOfRows As Integer
     NumberOfRows = Data1.Recordset.RecordCount
     Data1.Recordset.MoveFirst
'ÃÓãÇÁ ÇáÍÞæá
     For r = 1 To NumberOfRows
               DataArray(r, 1) = Data1.Recordset.Fields("ID")
               DataArray(r, 2) = Data1.Recordset.Fields("MaintenanceManagerPriority")
               DataArray(r, 3) = Data1.Recordset.Fields("LOTO")
               DataArray(r, 4) = Data1.Recordset.Fields("MAINTENANCE_SECTION")
               DataArray(r, 5) = Data1.Recordset.Fields("TSS")
               DataArray(r, 6) = Data1.Recordset.Fields("Work_Type")
               DataArray(r, 7) = Data1.Recordset.Fields("Work_Description")
               DataArray(r, 8) = Data1.Recordset.Fields("WC_Section_Code")
               DataArray(r, 9) = Data1.Recordset.Fields("Lines")
               DataArray(r, 10) = Data1.Recordset.Fields("Status")
               DataArray(r, 11) = Data1.Recordset.Fields("EBR")
               DataArray(r, 12) = Data1.Recordset.Fields("Date_Of_Request")
               DataArray(r, 13) = Data1.Recordset.Fields("Time_Of_Request")
               DataArray(r, 14) = Data1.Recordset.Fields("Issuing_Department")
               DataArray(r, 15) = Data1.Recordset.Fields("Issuing_Person")
               DataArray(r, 16) = Data1.Recordset.Fields("Request_Origin")
               DataArray(r, 17) = Data1.Recordset.Fields("Request_Reference")
               DataArray(r, 18) = Data1.Recordset.Fields("Work_Purpose")
               DataArray(r, 19) = Data1.Recordset.Fields("Timing")
               DataArray(r, 20) = Data1.Recordset.Fields("PRIORITY")
               DataArray(r, 21) = Data1.Recordset.Fields("Date_Of_Start")
               DataArray(r, 22) = Data1.Recordset.Fields("Requested_Comp_Date")
               DataArray(r, 23) = Data1.Recordset.Fields("Requested_Comp_Week")
               DataArray(r, 24) = Data1.Recordset.Fields("Requested_Comp_Time")
               DataArray(r, 25) = Data1.Recordset.Fields("PRS")
               DataArray(r, 26) = Data1.Recordset.Fields("ITEM")
               DataArray(r, 27) = Data1.Recordset.Fields("Est_Material_Approval_Date")
               DataArray(r, 28) = Data1.Recordset.Fields("Estimated_Duration")
               DataArray(r, 29) = Data1.Recordset.Fields("shift")
               DataArray(r, 30) = Data1.Recordset.Fields("Remarks")
     Data1.Recordset.MoveNext
     Next
  Set Eidan = Abbas.Worksheets(1)
  Eidan.Range("A1:AD1").Font.Bold = True
'   ÚäÇæíä ÇáÍÞæá
  Eidan.Range("A1:AD1").Value = Array("Id", "Maintenance Manager Priority", "Loto", "Maintenance Section", "TSS", "Work Type", "Work Description", "Wc Section Code", "Lines", "Status", "EBR", "Date Of Request", "Time Of Request", "Issuing Department", "Issuing Person", "Request Origin", "Request Reference", "Work Purpose", "Timing", "Priority", "Date Of Start", "Requested Comp. Date", "Requested Comp. Week", "Requested Comp Time", "PRS", "Item", "Est. Material Approval Date", "Est. Duration", "Shift", "Remarks")                             ' Put Headers Of Fields To Excel File
  Eidan.Range("A2").Resize(NumberOfRows, 30).Value = DataArray
  Abbas.SaveAs App.Path & "\AshrafElafify.xls"
  Anas.Quit
  Data1.Recordset.MoveFirst
  MsgBox "Complete...", 64, "Info"
End Sub


يرجى تغير ما يلزم من رؤوس الاعمدة و خلافة من بياناتى الى بياناتك.
لا اله الا انت سبحانك انى كنت من الظالمين.
اللهم انك عفو كريم حليم تحب العفو فاعفوا عنا.
اللّهُمَّ اغْفِرْ لِي وَلِوالِدَيَّ وَارْحَمْهُما كَما رَبَّيانِي صَغِيراً، اللَّهُمَّ اجْزِهِما بِالاِحْسانِ إِحْسانا وَبِالسَّيِّئاتِ غُفْرانا، اللَّهُمَّ اغْفِرْ لِلْمُؤْمِنينَ وَالمُؤْمِناتِ الاَحْياءِ مِنْهُمْ وَالاَمْواتِ.
سبحان الله والحمدلله ولا إله إلا الله والله أكبر زنه عرشك ومداد كلماتك ورضاء نفسك وكما ينبغى لجلال شأنك وعظيم سلطانك وعدد ما كان وعدد ما سيكون وعدد الحركات و السكون وعدد ما نعلم وعدد مالانعلم وعدد كل شيئ احصيته بعلمك يا كريم
الرد }}}}
تم الشكر بواسطة: ابومحمد1979
#3
جزاك الله خير ولاكن ماضبطت معي
الرد }}}}
تم الشكر بواسطة:


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  [سؤال] طلب كود للبحث عن اسم في قاعدة البيانات كلها وكود نقل سجل sher 7 217 18-10-17, 04:02 AM
آخر رد: عبد العزيز البسكري
  [سؤال] كيفية استيراد ملف اكسل الى قاعدة بيانات اكسس في فيجوال 6 sher 3 211 01-10-17, 02:37 AM
آخر رد: عبد العزيز البسكري
  انشاء ملف dll واضاقه على مشروع ارجوا مساعده nader309 2 198 07-07-17, 08:28 AM
آخر رد: nader309
  [سؤال] سؤال عن ربط قاعدة البيانات اكسس amer2000 4 327 14-05-17, 01:08 PM
آخر رد: Amir_alzubidy
  ادوات التنقل في قاعدة اجدول البيانات بواسطة List view haniblack 4 240 13-04-17, 09:57 AM
آخر رد: haniblack
  كيف اربط قاعدة البيانات ل سكول سرفير ahmed_egypt 8 874 05-04-17, 04:39 PM
آخر رد: ahmed_egypt
  تصدير االبيانات المحددة داخل listview الى برنامج الاكسل haniblack 6 380 28-03-17, 12:55 PM
آخر رد: haniblack
  [vb6.0] ارجوا التعديل على المشروع حيث يتكرر اسم المشروع في combobox1 عبدالقادرعواد 2 252 21-02-17, 03:36 PM
آخر رد: عبدالقادرعواد
  [سؤال] اصلاح قاعدة البيانات من نوع اكسس amer2000 4 724 15-12-16, 12:49 PM
آخر رد: Amir_alzubidy
  [سؤال] سؤال حول البحث. المتكرر في قاعدة البيانات وفرزها في التكستات عمور2016 10 1,022 10-12-16, 03:02 PM
آخر رد: عبد العزيز البسكري

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


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