تقييم الموضوع :
  • 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
جزاك الله خير ولاكن ماضبطت معي
الرد }}}}
تم الشكر بواسطة:


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  [سؤال] سؤال حول البحث. المتكرر في قاعدة البيانات وفرزها في التكستات عمور2016 7 93 منذ 6 ساعة مضت
آخر رد: عمور2016
  [ تم الحل ] : ربط الكومبو بقاعدة البيانات عبد العزيز البسكري 3 111 28-11-16, 10:55 PM
آخر رد: عبد العزيز البسكري
  [سؤال] اصلاح قاعدة البيانات من نوع اكسس amer2000 2 66 23-11-16, 02:27 PM
آخر رد: amer2000
  سوال عن قاعدة البيانات Hamed_85ltt 3 91 22-11-16, 10:21 PM
آخر رد: Amir_alzubidy
  مشاركة قاعدة البيانات على الانترنت haniblack 3 119 20-11-16, 09:50 PM
آخر رد: Top GreaT
  [vb6.0] كيف اربط كمبوبوكس بجدول فى قاعدة البيانات ابراهيم حورس 6 198 03-11-16, 09:14 PM
آخر رد: زياد مقداد
  تغيير محتويات الصف بالكامل في جدول قاعدة البيانات haniblack 2 107 11-10-16, 04:20 PM
آخر رد: haniblack
  كيف اربط قاعدة البيانات ل سكول سرفير ahmed_egypt 7 244 07-10-16, 10:47 PM
آخر رد: Amir_alzubidy
  مساعدة في كود جلب الصورة وحفظها في قاعدة البيانات مصمم هاوي 3 176 04-09-16, 09:36 AM
آخر رد: مصمم هاوي
  كيفية اضافة صورة فى قاعدة البيانات ووضعها فى msflexgrid ؟ gedo 7 243 02-09-16, 04:36 PM
آخر رد: gedo

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


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