#Region "Export To Excel" Public Sub ExportToExcel(DGVXT As DataGridView, Optional OpenDialog As Boolean = False, Optional SameColumnsWidth As Boolean = True) If DGVXT.RowCount < 1 Then MsgBox("لا يوجد سجلات للتصدير ") Exit Sub End If Dim FlNm As String = "" Dim sv As New SaveFileDialog sv.FileName = "Microsoft Excel File" sv.Filter = "|*.xls" If sv.ShowDialog <> DialogResult.OK Then Exit Sub FlNm = sv.FileName Dim fs As New System.IO.StreamWriter(FlNm, False) With fs .WriteLine("<?xml version=""1.0""?>") .WriteLine("<?mso-application progid=""Excel.Sheet""?>") .WriteLine("<Workbook xmlns=""urn:schemas-microsoft-com:office:spreadsheet"">") .WriteLine(" <Styles>") .WriteLine(" <Style ss:ID=""hdr"">") .WriteLine(" <Alignment ss:Horizontal=""Center""/>") .WriteLine(" <Borders>") .WriteLine(" <Border ss:Position=""Left"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>") .WriteLine(" <Border ss:Position=""Right"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>") .WriteLine(" <Border ss:Position=""Top"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>") .WriteLine(" </Borders>") .WriteLine(" <Font ss:FontName=""Calibri"" ss:Size=""11"" ss:Bold=""1""/>") 'SET FONT .WriteLine(" </Style>") .WriteLine(" <Style ss:ID=""ksg"">") .WriteLine(" <Alignment ss:Vertical=""Bottom""/>") .WriteLine(" <Borders/>") .WriteLine(" <Font ss:FontName=""Calibri""/>") 'SET FONT .WriteLine(" </Style>") .WriteLine(" <Style ss:ID=""isi"">") .WriteLine(" <Borders>") .WriteLine(" <Border ss:Position=""Bottom"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>") .WriteLine(" <Border ss:Position=""Left"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>") .WriteLine(" <Border ss:Position=""Right"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>") .WriteLine(" <Border ss:Position=""Top"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>") .WriteLine(" </Borders>") .WriteLine(" <Font ss:FontName=""Calibri"" ss:Size=""10""/>") .WriteLine(" </Style>") .WriteLine(" </Styles>") .WriteLine(" <Worksheet ss:Name=""sheet1"">") .WriteLine(" <Table>") If SameColumnsWidth Then For i = 0 To DGVXT.ColumnCount - 1 .WriteLine(" <Column ss:Width=""" & DGVXT.Columns(i).Width & """/>") Next End If .WriteLine(" <Row ss:StyleID=""ksg"">") For i As Integer = 0 To DGVXT.Columns.Count - 1 Application.DoEvents() .WriteLine(" <Cell ss:StyleID=""hdr"">") .WriteLine(" <Data ss:Type=""String"">{0}</Data>", DGVXT.Columns.Item(i).HeaderText) .WriteLine(" </Cell>") Next .WriteLine(" </Row>") If DGVXT.AllowUserToAddRows = False Then For intRow As Integer = 0 To DGVXT.RowCount - 1 Application.DoEvents() .WriteLine(" <Row ss:StyleID=""ksg"" ss:utoFitHeight =""0"">") For intCol As Integer = 0 To DGVXT.Columns.Count - 1 Application.DoEvents() If DGVXT.Item(intCol, intRow).Value Is Nothing Then Continue For End If .WriteLine(" <Cell ss:StyleID=""isi"">") .WriteLine(" <Data ss:Type=""String"">{0}</Data>", DGVXT.Item(intCol, intRow).Value.ToString) .WriteLine(" </Cell>") Next .WriteLine(" </Row>") Next Else For intRow As Integer = 0 To DGVXT.RowCount - 2 Application.DoEvents() .WriteLine(" <Row ss:StyleID=""ksg"" ss:utoFitHeight =""0"">") For intCol As Integer = 0 To DGVXT.Columns.Count - 1 Application.DoEvents() If DGVXT.Item(intCol, intRow).Value Is Nothing Then Continue For End If .WriteLine(" <Cell ss:StyleID=""isi"">") .WriteLine(" <Data ss:Type=""String"">{0}</Data>", DGVXT.Item(intCol, intRow).Value.ToString) .WriteLine(" </Cell>") Next .WriteLine(" </Row>") Next End If .WriteLine(" </Table>") .WriteLine(" </Worksheet>") .WriteLine("</Workbook>") .Close() If OpenDialog Then Dim msg1 msg1 = MsgBox("تمت عملية الحفظ بنجاح .. هل تريد فتح الملف ؟", MsgBoxStyle.YesNo + MsgBoxStyle.Question, "تصدير ملف") If msg1 = vbNo Then Exit Sub Process.Start(FlNm) End If End With End Sub Public Sub ExportDaTaTableToExcel(DaTaTableXT As DataTable, Optional OpenDialog As Boolean = False, Optional SameColumnsWidth As Boolean = True) If DaTaTableXT.Rows.Count < 1 Then MsgBox("لا يوجد سجلات للتصدير ") Exit Sub End If Dim FlNm As String = "" Dim sv As New SaveFileDialog sv.FileName = "Microsoft Excel File" sv.Filter = "|*.xls" If sv.ShowDialog <> DialogResult.OK Then Exit Sub FlNm = sv.FileName Dim fs As New System.IO.StreamWriter(FlNm, False) With fs .WriteLine("<?xml version=""1.0""?>") .WriteLine("<?mso-application progid=""Excel.Sheet""?>") .WriteLine("<Workbook xmlns=""urn:schemas-microsoft-com:office:spreadsheet"">") .WriteLine(" <Styles>") .WriteLine(" <Style ss:ID=""hdr"">") .WriteLine(" <Alignment ss:Horizontal=""Center""/>") .WriteLine(" <Borders>") .WriteLine(" <Border ss:Position=""Left"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>") .WriteLine(" <Border ss:Position=""Right"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>") .WriteLine(" <Border ss:Position=""Top"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>") .WriteLine(" </Borders>") .WriteLine(" <Font ss:FontName=""Calibri"" ss:Size=""11"" ss:Bold=""1""/>") 'SET FONT .WriteLine(" </Style>") .WriteLine(" <Style ss:ID=""ksg"">") .WriteLine(" <Alignment ss:Vertical=""Bottom""/>") .WriteLine(" <Borders/>") .WriteLine(" <Font ss:FontName=""Calibri""/>") 'SET FONT .WriteLine(" </Style>") .WriteLine(" <Style ss:ID=""isi"">") .WriteLine(" <Borders>") .WriteLine(" <Border ss:Position=""Bottom"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>") .WriteLine(" <Border ss:Position=""Left"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>") .WriteLine(" <Border ss:Position=""Right"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>") .WriteLine(" <Border ss:Position=""Top"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>") .WriteLine(" </Borders>") .WriteLine(" <Font ss:FontName=""Calibri"" ss:Size=""10""/>") .WriteLine(" </Style>") .WriteLine(" </Styles>") .WriteLine(" <Worksheet ss:Name=""sheet1"">") .WriteLine(" <Table>") If SameColumnsWidth Then For i = 0 To DaTaTableXT.Columns.Count - 1 .WriteLine(" <Column ss:Width=""" & 120 & """/>") ''DaTaTableXT.Columns(i).Width Next End If .WriteLine(" <Row ss:StyleID=""ksg"">") For i As Integer = 0 To DaTaTableXT.Columns.Count - 1 Application.DoEvents() .WriteLine(" <Cell ss:StyleID=""hdr"">") .WriteLine(" <Data ss:Type=""String"">{0}</Data>", DaTaTableXT.Columns.Item(i).Caption) .WriteLine(" </Cell>") Next .WriteLine(" </Row>") For intRow As Integer = 0 To DaTaTableXT.Rows.Count - 1 Application.DoEvents() .WriteLine(" <Row ss:StyleID=""ksg"" ss:utoFitHeight =""0"">") For intCol As Integer = 0 To DaTaTableXT.Columns.Count - 1 Application.DoEvents() If DaTaTableXT.Rows(intRow)(intCol) Is Nothing Then Continue For End If .WriteLine(" <Cell ss:StyleID=""isi"">") .WriteLine(" <Data ss:Type=""String"">{0}</Data>", DaTaTableXT.Rows(intRow)(intCol).ToString) .WriteLine(" </Cell>") Next .WriteLine(" </Row>") Next .WriteLine(" </Table>") .WriteLine(" </Worksheet>") .WriteLine("</Workbook>") .Close() If OpenDialog Then Dim msg1 msg1 = MsgBox("تمت عملية الحفظ بنجاح .. هل تريد فتح الملف ؟", MsgBoxStyle.YesNo + MsgBoxStyle.Question + MsgBoxStyle.MsgBoxRight + MsgBoxStyle.MsgBoxRtlReading, "تصدير ملف") If msg1 = vbNo Then Exit Sub Process.Start(FlNm) End If End With End Sub Public Result As New DataSet() Public Sub ImportExcelFile(dgv As DataGridView, comboBox1 As ComboBox) dgv.DataSource = Nothing Dim Ofd As New OpenFileDialog() Ofd.Filter = "Excel 2007|*.xlsx|Excel 2003|*.xls" Ofd.ValidateNames = True If Ofd.ShowDialog() = DialogResult.OK Then Dim filePath As String = Ofd.FileName Dim fs As System.IO.FileStream = System.IO.File.Open(filePath, System.IO.FileMode.Open, System.IO.FileAccess.Read) Dim Reader As Excel.IExcelDataReader If Ofd.FilterIndex = 0 Then Reader = Excel.ExcelReaderFactory.CreateBinaryReader(fs) Else Reader = Excel.ExcelReaderFactory.CreateOpenXmlReader(fs) End If
Reader.IsFirstRowAsColumnNames = True Result = Reader.AsDataSet() comboBox1.Items.Clear() If Not Result Is Nothing Then For Each Dt As DataTable In Result.Tables comboBox1.Items.Add(Dt.TableName) Next Reader.Close() End If End If End Sub #End Region
في المرفقات مكتبة ديناميكية إضفها لمكتبات مشروعك .
سبحان الله وبحمده سبحان الله العظيم و الحمد لله ولا اله الا الله والله اكبر
01-07-21, 06:52 PM (آخر تعديل لهذه المشاركة : 01-07-21, 06:57 PM {2} بواسطة خالد20.)
شكرا لردك الكريم
ولكن للاسف الكود لا يعمل المطلوب ان هذا الكود هو لتصدير بيانات من داتا جريد فيو الى اكسل
المشكلة هي كالاتي
لدي جدول في سيكوال سيرفر فيه حقل ترقيم تلقائي وحقل مفتاح رئيسي اريد تصدير كافة البيانات التي فيه الى جدول مماثل ولكن فيه حقول اضافيية موجود على قاعد بيانات اخرى
يعني عملية التصدير ستكون الى ملف ايا كا ن نوعه لا يهم وانا سآخذ الملف على فلاش ميميوري ثم اذهب للحاسب الاخر واستورد البيانات
علما ان الجدول الثاني مطابق تماما بترتيب الاعمدة وكل شيء للجدول الاول الا انه يحتوي على عمودين اضافيين بالاخر
يتوفر لدينا برنامج مبيعات يصلح لاغراض تعليمية وتجارية
Public Sub ExportToExcel(DGVXT As DataGridView, Optional OpenDialog As Boolean = False, Optional SameColumnsWidth As Boolean = True) If DGVXT.RowCount < 1 Then MsgBox("لا يوجد سجلات للتصدير ") Exit Sub End If Dim FlNm As String = "" Dim sv As New SaveFileDialog sv.FileName = "Microsoft Excel File" sv.Filter = "|*.xls" If sv.ShowDialog <> DialogResult.OK Then Exit Sub FlNm = sv.FileName Dim fs As New System.IO.StreamWriter(FlNm, False) With fs .WriteLine("<?xml version=""1.0""?>") .WriteLine("<?mso-application progid=""Excel.Sheet""?>") .WriteLine("<Workbook xmlns=""urn:schemas-microsoft-com:office:spreadsheet"">") .WriteLine(" <Styles>") .WriteLine(" <Style ss:ID=""hdr"">") .WriteLine(" <Alignment ss:Horizontal=""Center""/>") .WriteLine(" <Borders>") .WriteLine(" <Border ss:Position=""Left"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>") .WriteLine(" <Border ss:Position=""Right"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>") .WriteLine(" <Border ss:Position=""Top"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>") .WriteLine(" </Borders>") .WriteLine(" <Font ss:FontName=""Calibri"" ss:Size=""11"" ss:Bold=""1""/>") 'SET FONT .WriteLine(" </Style>") .WriteLine(" <Style ss:ID=""ksg"">") .WriteLine(" <Alignment ss:Vertical=""Bottom""/>") .WriteLine(" <Borders/>") .WriteLine(" <Font ss:FontName=""Calibri""/>") 'SET FONT .WriteLine(" </Style>") .WriteLine(" <Style ss:ID=""isi"">") .WriteLine(" <Borders>") .WriteLine(" <Border ss:Position=""Bottom"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>") .WriteLine(" <Border ss:Position=""Left"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>") .WriteLine(" <Border ss:Position=""Right"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>") .WriteLine(" <Border ss:Position=""Top"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>") .WriteLine(" </Borders>") .WriteLine(" <Font ss:FontName=""Calibri"" ss:Size=""10""/>") .WriteLine(" </Style>") .WriteLine(" </Styles>") .WriteLine(" <Worksheet ss:Name=""sheet1"">") .WriteLine(" <Table>") If SameColumnsWidth Then For i = 0 To DGVXT.ColumnCount - 1 .WriteLine(" <Column ss:Width=""" & DGVXT.Columns(i).Width & """/>") Next End If .WriteLine(" <Row ss:StyleID=""ksg"">") For i As Integer = 0 To DGVXT.Columns.Count - 1 Application.DoEvents() .WriteLine(" <Cell ss:StyleID=""hdr"">") .WriteLine(" <Data ss:Type=""String"">{0}</Data>", DGVXT.Columns.Item(i).HeaderText) .WriteLine(" </Cell>") Next .WriteLine(" </Row>") If DGVXT.AllowUserToAddRows = False Then For intRow As Integer = 0 To DGVXT.RowCount - 1 Application.DoEvents() .WriteLine(" <Row ss:StyleID=""ksg"" ss:utoFitHeight =""0"">") For intCol As Integer = 0 To DGVXT.Columns.Count - 1 Application.DoEvents() If DGVXT.Item(intCol, intRow).Value Is Nothing Then Continue For End If .WriteLine(" <Cell ss:StyleID=""isi"">") .WriteLine(" <Data ss:Type=""String"">{0}</Data>", DGVXT.Item(intCol, intRow).Value.ToString) .WriteLine(" </Cell>") Next .WriteLine(" </Row>") Next Else For intRow As Integer = 0 To DGVXT.RowCount - 2 Application.DoEvents() .WriteLine(" <Row ss:StyleID=""ksg"" ss:utoFitHeight =""0"">") For intCol As Integer = 0 To DGVXT.Columns.Count - 1 Application.DoEvents() If DGVXT.Item(intCol, intRow).Value Is Nothing Then Continue For End If .WriteLine(" <Cell ss:StyleID=""isi"">") .WriteLine(" <Data ss:Type=""String"">{0}</Data>", DGVXT.Item(intCol, intRow).Value.ToString) .WriteLine(" </Cell>") Next .WriteLine(" </Row>") Next End If .WriteLine(" </Table>") .WriteLine(" </Worksheet>") .WriteLine("</Workbook>") .Close() If OpenDialog Then Dim msg1 msg1 = MsgBox("تمت عملية الحفظ بنجاح .. هل تريد فتح الملف ؟", MsgBoxStyle.YesNo + MsgBoxStyle.Question, "تصدير ملف") If msg1 = vbNo Then Exit Sub Process.Start(FlNm) End If End With End Sub
ضع في زر التصدير الكود التالي :
PHP كود :
ExportToExcel(DataGridView1,true, True)
للاستيراد أولا تأكد من إستيراد المكتبة المرفقة و فضاء الاسماء الخاص بها و هذا ايضا كود عام يوضع في مديول :
Public Result As New DataSet() Public Sub ImportExcelFile(dgv As DataGridView, comboBox1 As ComboBox) dgv.DataSource = Nothing Dim Ofd As New OpenFileDialog() Ofd.Filter = "Excel 2007|*.xlsx|Excel 2003|*.xls" Ofd.ValidateNames = True If Ofd.ShowDialog() = DialogResult.OK Then Dim filePath As String = Ofd.FileName Dim fs As System.IO.FileStream = System.IO.File.Open(filePath, System.IO.FileMode.Open, System.IO.FileAccess.Read) Dim Reader As Excel.IExcelDataReader If Ofd.FilterIndex = 0 Then Reader = Excel.ExcelReaderFactory.CreateBinaryReader(fs) Else Reader = Excel.ExcelReaderFactory.CreateOpenXmlReader(fs) End If
Reader.IsFirstRowAsColumnNames = True Result = Reader.AsDataSet() comboBox1.Items.Clear() If Not Result Is Nothing Then For Each Dt As DataTable In Result.Tables comboBox1.Items.Add(Dt.TableName) Next Reader.Close() End If End If End Sub
ضع في زر الاستيراد الكود التالي :
PHP كود :
'الكومبو بوكس لتحدد عن طريقها اسم الجدول'ImportExcelFile(DataGridView, comboBox1)
سبحان الله وبحمده سبحان الله العظيم و الحمد لله ولا اله الا الله والله اكبر