تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
[VB.NET] كود تصدير قاعدة البيانات إلى ملف Excel
#1
السلام عليكم ورحمة الله وبركاته
تقبل الله منا ومنك الصيام وصالح الاعمال
تمنياتي أن تكونو جميعا في أتم صحه وعافيه

لدي كود تصدير جدول DataGrid إلى ملف Excel 
ولكن تظهر لي مشكلة لا لم أستطع أن أجد لها حل
كود :
   Private Sub butt_export_Ex_Click(sender As Object, e As EventArgs) Handles butt_.Click
       Try
           butt_.Text = "Please Wait..."
           butt_.Enabled = False

           SaveFileDialog1.Filter = "Excel Document (*.xlsx)|*.xlsx"
           If SaveFileDialog1.ShowDialog() = System.Windows.Forms.DialogResult.OK Then
               Dim xlApp As Microsoft.Office.Interop.Excel.Application
               Dim xlWorkBook As Microsoft.Office.Interop.Excel.Workbook
               Dim xlWorkSheet As Microsoft.Office.Interop.Excel.Worksheet
               Dim misValue As Object = System.Reflection.Missing.Value
               Dim i As Integer
               Dim j As Integer

               xlApp = New Microsoft.Office.Interop.Excel.Application
               xlWorkBook = xlApp.Workbooks.Add(misValue)
               xlWorkSheet = xlWorkBook.Sheets("sheet1")

               For i = 0 To DataGridView1.RowCount - 2
                   For j = 0 To DataGridView1.ColumnCount - 1
                       For k As Integer = 1 To DataGridView1.Columns.Count
                           xlWorkSheet.Cells(1, k) = DataGridView1.Columns(k - 1).HeaderText
                           xlWorkSheet.Cells(i + 2, j + 1) = DataGridView1(j, i).Value.ToString()
                       Next
                   Next
               Next

               xlWorkSheet.SaveAs(SaveFileDialog1.FileName)
               xlWorkBook.Close()
               xlApp.Quit()

               releaseObject(xlApp)
               releaseObject(xlWorkBook)
               releaseObject(xlWorkSheet)

               MsgBox("Successfully saved" & vbCrLf & "File are saved at : " & SaveFileDialog1.FileName, MsgBoxStyle.Information, "Information")

               butt_.Text = "Export To MS Excel"
               butt_.Enabled = True
           End If
       Catch ex As Exception
           MessageBox.Show("Failed to save !!!", "Error Message", MessageBoxButtons.OK, MessageBoxIcon.Error)
           Return
       End Try
   End Sub

   Private Sub releaseObject(ByVal obj As Object)
       Try
           System.Runtime.InteropServices.Marshal.ReleaseComObject(obj)
           obj = Nothing
       Catch ex As Exception
           obj = Nothing
       Finally
           GC.Collect()
       End Try
   End Sub
End Class

وهذي صورة من المشكلة

   
الرد
تم الشكر بواسطة:
#2
جرب تغير السطر
كود :
xlWorkSheet = xlWorkBook.Sheets("sheet1")
بالسطر التالي
كود :
xlWorkSheet = xlWorkBook.Sheets(1)

وهذا كود عام بامكانك ان تضعه بموديل وتستدعيه وتمرر له فقط اسم الداتا جرد فيو
كود :
Public Sub dgv_ExportDataToExcelFile(ByVal dgv As DataGridView)
       System.Threading.Thread.CurrentThread.CurrentCulture = System.Globalization.CultureInfo.CreateSpecificCulture("ar-SA")
       Dim SFD As New SaveFileDialog
       Dim exlapp As New Application
       Dim exlworkbook As Workbook
       Dim exlworksheet As Worksheet
       Dim misvalue As Object = System.Reflection.Missing.Value
       exlworkbook = exlapp.Workbooks.Add(misvalue)
       exlworksheet = exlworkbook.Sheets(1)
       exlworksheet.DisplayRightToLeft = True
       For colhead As Integer = 0 To dgv.ColumnCount - 1
           exlworksheet.Cells(1, colhead + 1) = dgv.Columns(colhead).HeaderText
       Next
       For i As Integer = 0 To dgv.RowCount - 1
           For j As Integer = 0 To dgv.ColumnCount - 1
               exlworksheet.Cells(i + 2, j + 1) = dgv.Rows(i).Cells(j).Value.ToString
           Next
       Next
       SFD.Filter = "Excel Files|*.xlsx|Excel 2003|*.xls"
       If SFD.ShowDialog = System.Windows.Forms.DialogResult.OK Then
           exlworksheet.SaveAs(SFD.FileName)
       End If
       exlworkbook.Close()
       exlapp.Quit()
       System.Runtime.InteropServices.Marshal.ReleaseComObject(exlapp)
       System.Runtime.InteropServices.Marshal.ReleaseComObject(exlworkbook)
       System.Runtime.InteropServices.Marshal.ReleaseComObject(exlworksheet)
       exlapp = Nothing : exlworkbook = Nothing : exlworksheet = Nothing
       If MessageBox.Show("هل تريد فتح الملف ؟", "فتح ملف الأكسل", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1, MessageBoxOptions.RtlReading) = MsgBoxResult.Yes Then
           Process.Start(SFD.FileName)
       End If
   End Sub
ولاستدعاء الامر كل ما عليك هو

كود :
dgv_ExportDataToExcelFile(صع هنا اسم الداتا جرد فيو)
الرد
#3
السلام عليكم ورحمة الله وبركاته
اخي محمد العامر واضح انك تستخدم اوفيس 2003 وهي المشكلة
من خلال تجربتي السابقة مع التصدير الى اكسل الامر يتعلق بنسخة الاوفيس التي تستخدمها (المعروف ان برامجنا كلها مقرصنة والكثير منها ملفاته ناقصة)
كنت فيما مصى استخدم اوفيس 2003 وعند التصدير الى اكسل كان يظهر لي الخطأ بفشل عملية التصدير وعانيت الكثير منها في الوقت الذي كان غيري تنجح معه العملية ولكن لاأحد كان ينتبه الى نسخة الاوفيس المستخدمة لان هناك ملفات Dll تستخدم في العملية لاستقبال التصدير المشكلة لاتظهر مع نسخة اعلى من 2003
المهم قمت (بالاحتيال ) ونفس الكود جعلته يعيد المحاولة حتى يقوم بالعملية والان انا استحدم اوفيس 2016 ومن باب التجربة من بعد سؤالك فتحت المشروع السابق والغيت عبارة اعادة المحاولة وكانت المفاجأة بان عمل الكود نفسه بكفاءة عالية وسأورد لك الكود ولاحط هذه الجملة 
كود :
'GoTo gg ' اضطررت لاستخدام هذه العبارة وضحكت من نفسي على استخدامها
التي كنت قد وضعتها في Catch ex As Exception وكتبت بجانبها وقتها تعليق بالعربية
وموقع gg ليعيد المحاولة 
الان الغيتهما  اليك الكود
كود :
Private Sub Btn_ExToExcel_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Btn_ExToExcel.Click
       If dgv_table.Rows.Count = 0 Then
           Exit Sub
       Else
           System.Threading.Thread.CurrentThread.CurrentCulture = System.Globalization.CultureInfo.CreateSpecificCulture("en-US")
           System.Windows.Forms.Cursor.Current = System.Windows.Forms.Cursors.WaitCursor
           'gg:
           Try
               Dim xlApp As New Application
               Dim excelworkBook As Microsoft.Office.Interop.Excel.Workbook = xlApp.Workbooks.Add
               Dim excelWorksheet As Microsoft.Office.Interop.Excel.Worksheet = CType(excelworkBook.Worksheets(1), Worksheet)
               xlApp.Visible = False
               Dim currCol As Integer = 1
               excelWorksheet.Cells.Select()
               excelWorksheet.Cells.Delete()
               For iC As Integer = 0 To dgv_table.Columns.Count - 1
                   If dgv_table.Columns(iC).Visible = True Then
                       excelWorksheet.Cells(1, currCol).Value = dgv_table.Columns(iC).HeaderText
                       currCol += 1
                   End If
               Next
               For i As Integer = 0 To dgv_table.RowCount - 2
                   currCol = 1
                   For j As Integer = 0 To dgv_table.Columns.Count - 1
                       If dgv_table.Columns(j).Visible = True Then
                           excelWorksheet.Cells(i + 2, currCol).value = dgv_table.Rows(i).Cells(j).FormattedValue
                           currCol += 1
                       End If
                   Next
               Next

               excelWorksheet.Rows("1:1").Font.FontStyle = "Normal"
               excelWorksheet.Rows("1:1").Font.Size = 10
               excelWorksheet.Cells.Columns.AutoFit()
               excelWorksheet.Cells.Select()
               excelWorksheet.Cells.EntireColumn.AutoFit()
               excelWorksheet.Cells(1, 1).Select()
               xlApp.Visible = True
           Catch ex As Exception
               'GoTo gg ' اضطررت لاستخدام هذه العبارة وضحكت من نفسي على استخدامها
               'MsgBox("Export Excel Error " & ex.Message)
               MsgBox("فشلت عملية التصدير حاول مرة ثانية")
           Finally
               System.Windows.Forms.Cursor.Current = System.Windows.Forms.Cursors.Default

           End Try
       End If
   End Sub
ملاحظة : غير اسم الداتا غرايد من dgv_table الى اسم الداتاغرايد التي تستخدمها
وهناك شيئ أخر هو هذا السطر 
كود :
System.Threading.Thread.CurrentThread.CurrentCulture = System.Globalization.CultureInfo.CreateSpecificCulture("en-US")
حيث سيظهر الجدول بالتنسيق الانكليزي اي يسار ان اردت اظهاره من اليمين استخدم بدلا 
منه هذا السطر
كود :
System.Threading.Thread.CurrentThread.CurrentCulture = System.Globalization.CultureInfo.CreateSpecificCulture("ar-SA")
اعمل الخير واجرك لاتنتظره فالله خير من اليك يرده
البرمجة ليست مجرد كود بل هي منهج تفكير منطقي لحل المشكلات







الرد
#4
اهلا وسهلا يا استاذي الفاضل
الكود يعلق معي إذا كان فيه بيانات في الداتا جريد فيو
جربت أشغل الكود دون بيانات وجود بيانات في الداتا جريد فيو واشتغل دون مشاكل
هل حجم البيانات له تأثير لدرجة أنه يجعل الكود يعلق ؟!

استاذي القدير إبراهيم
نفع الله بك
أنا أستخدم أوفس 2016 ونسخه أصليه لكن لم أجدد الاشتراك ^_^
المهم الكود الذي قمت بتعديله أنت سريع الاستجابة ولكن تظهر لي رسالة الفشل
كود :
 MsgBox("فشلت عملية التصدير حاول مرة ثانية")
الرد
#5
السلام عليكم اخي محمد
كما ذكرت لك الكود بهذا الشكل يعمل معي بشكل ممتاز بعد ان عملت كومانت على السطر الذي اشرت اليه
بامكانك ازالة الكومانت وتجرب ربما يصطلح الامر (التجربة هي الفيصل)
اعمل الخير واجرك لاتنتظره فالله خير من اليك يرده
البرمجة ليست مجرد كود بل هي منهج تفكير منطقي لحل المشكلات







الرد
#6
ماهو تسير هذا الخطأ

كود :
Additional information: تعذر إجراء عملية تحويل نوع لكائن COM من النوع 'System.__ComObject' إلى نوع الواجهة 'Microsoft.Office.Interop.Excel.Range'. يرجع السبب في فشل هذه العملية إلى فشل استدعاء QueryInterface في مكون COM للواجهة التي لها المعرف '{00020846-0000-0000-C000-000000000046}' بسبب الخطأ التالي: The RPC server is unavailable. (استثناء من HRESULT: 0x800706BA).
الرد
#7
السلام عليكم ورحمة الله وبركاته

المشكلة في هذا الريفرانس Microsoft.Office.Interop.Excel

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







الرد
تم الشكر بواسطة: عبد العزيز البسكري


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  مشكله في الوصول الى قاعدة بيانات 2007 عند تغيرها 2016 alshandodi 7 113 29-05-20, 11:34 AM
آخر رد: معاند الحظ
  تنفيذ استعلام حذف البيانات في جدول قاعدة بيانات سيكوال سيرفر باستخدام الكود في فجوال momani33 4 91 28-05-20, 12:46 AM
آخر رد: اسامه الهرماوي
  مشكلة في الترقيم التلقائي في قاعدة بيانات سيكوال سيرفر momani33 3 76 27-05-20, 11:49 PM
آخر رد: momani33
  [سؤال] تصدير البيانات منه 1 33 27-05-20, 10:46 PM
آخر رد: منه
  مشكلة معقدة بعرض البيانات بالدتاجريد على ما فكرت فيها لم اجد لها حل ابو محمد محمد محمد 10 268 24-05-20, 12:16 PM
آخر رد: ابو محمد محمد محمد
  [سؤال] مشكلة في اتصال قاعدة البيانات اكسس mazentq 9 200 24-05-20, 08:45 AM
آخر رد: mazentq
  [VB.NET] التعديل على كود لقرائة باقي المعلومات من قاعدة البيانات khairallah 1 62 24-05-20, 03:19 AM
آخر رد: اسامه الهرماوي
  [سؤال] مشكل اتصال قاعدة بينات في الفيجول 2017 ahmedbezia 2 72 20-05-20, 05:51 PM
آخر رد: rochdi191
  [VB.NET] كيف يتم تخزين المعلومات الموجودة في الداتا قريد غير متصلة بقاعدة البيانات rochdi191 8 144 16-05-20, 08:23 AM
آخر رد: عبدالله الدوسري
  طلب و أتمنى لو موجود: قاعدة بيانات أدوية DR.YASER 2 118 16-05-20, 05:47 AM
آخر رد: عبد العزيز البسكري

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


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