تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
[vb6.0] هذا كود سريع جدا لتصدير البيانات الى اكسيل بس البيانات بتظهر فى شكل نص فى اكسيل اريد
#1
هذا كود سريع جدا لتصدير البيانات الى اكسيل بس البيانات بتظهر فى شكل نص فى اكسيل اريد جعل بيانات تظهر بشكل رقمى فى اكسيل كيف ؟
Imports System.IO

Public Class FrmDemo

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

        With DataGridView1
            .Columns.Clear()
            .Columns.Add("No", "No")
            .Columns.Add("NIK", "NIK")
            .Columns.Add("Nama", "Nama")
            .Columns.Add("Alamat", "Alamat")
            .Columns.Add("Telp", "Telp")
        End With

    End Sub

    Private Sub BtnLoadData_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnLoadData.Click

        BtnLoadData.Text = "Please Wait..."
        BtnLoadData.Enabled = False
        Application.DoEvents()

        'LOAD 10000 ROWS INTO DATAGRIDVIEW
        For i As Integer = 1 To 10000
            With DataGridView1.Rows
                .Add(i, "3112" & i, "Student " & i, "Indonesia " & i, "021-" & i)
            End With
            Application.DoEvents()
        Next

        BtnLoadData.Text = "Load Data"
        BtnLoadData.Enabled = True

    End Sub

    Dim FlNm As String

    Private Sub ExportToExcel(ByVal DGV As DataGridView)
        Dim fs As New StreamWriter(FlNm, False)
        With fs
            .WriteLine("<?xml version=""1.0""?>")
            .WriteLine("<?mso-application progid=""Excel.Sheet""?>")
            .WriteLine("<Workbook xmlns=""urnConfusedchemas-microsoft-com:officeConfusedpreadsheet"">")
            .WriteLine("    <Styles>")
            .WriteLine("        <Style ss:ID=""hdr"">")
            .WriteLine("            <Alignment ss:Horizontal=""Center""/>")
            .WriteLine("            <Borders>")
            .WriteLine("                <Border ssTongueosition=""Left"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>")
            .WriteLine("                <Border ssTongueosition=""Right"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>")
            .WriteLine("                <Border ssTongueosition=""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 ssTongueosition=""Bottom"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>")
            .WriteLine("                <Border ssTongueosition=""Left"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>")
            .WriteLine("                <Border ssTongueosition=""Right"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>")
            .WriteLine("                <Border ssTongueosition=""Top"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>")
            .WriteLine("            </Borders>")
            .WriteLine("            <Font ss:FontName=""Calibri"" ss:Size=""10""/>") 'SET FONT
            .WriteLine("           <NumberFormat ss:Format=""0.00""/>")
String
"            <Data ss:Type=""String"">{0}</Data>",
            .WriteLine("        </Style>")
            .WriteLine("    </Styles>")
            If DGV.Name = "Student" Then
                .WriteLine("    <Worksheet ss:Name=""Student"">") 'SET NAMA SHEET
                .WriteLine("        <Table>")
                .WriteLine("            <Column ss:Width=""27.75""/>") 'No
                .WriteLine("            <Column ss:Width=""93""/>") 'NIK
                .WriteLine("            <Column ss:Width=""84""/>") 'Nama
                .WriteLine("            <Column ss:Width=""100""/>") 'Alamat
                .WriteLine("            <Column ss:Width=""84""/>") 'Telp
            End If
            'AUTO SET HEADER
            .WriteLine("            <Row ss:StyleID=""ksg"">")
            For i As Integer = 0 To DGV.Columns.Count - 1 'SET HEADER
                Application.DoEvents()
                .WriteLine("            <Cell ss:StyleID=""hdr"">")
                .WriteLine("                <Data ss:Type=""String"">{0}</Data>", DGV.Columns.Item(i).HeaderText)
                .WriteLine("            </Cell>")
            Next
            .WriteLine("            </Row>")
            For intRow As Integer = 0 To DGV.RowCount - 1
                Application.DoEvents()
                .WriteLine("        <Row ss:StyleID=""ksg"" ss:utoFitHeight =""0"">")
                For intCol As Integer = 0 To DGV.Columns.Count - 1
                    Application.DoEvents()
                    .WriteLine("        <Cell ss:StyleID=""isi"">")
                    .WriteLine("            <Data ss:Type=""String"">{0}</Data>", DGV.Item(intCol, intRow).Value.ToString)
                    .WriteLine("        </Cell>")
                Next
                .WriteLine("        </Row>")
            Next
            .WriteLine("        </Table>")
            .WriteLine("    </Worksheet>")
            .WriteLine("</Workbook>")
            .Close()
        End With
    End Sub

    Private Sub BtnExport_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnExport.Click

        If DataGridView1.RowCount = 0 Then Return

        BtnExport.Text = "Please Wait..."
        BtnExport.Enabled = False
        Application.DoEvents()

        Dim DGV As New DataGridView

        With DGV
            .AllowUserToAddRows = False
            .Name = "Student"
            .Visible = False
            .Columns.Clear()
            .Columns.Add("No", "No")
            .Columns.Add("NIK", "NIK")
            .Columns.Add("Nama", "Nama")
            .Columns.Add("Alamat", "Alamat")
            .Columns.Add("Telp", "Telp")
        End With
        With DataGridView1
            If .Rows.Count > 0 Then
                For i As Integer = 0 To .Rows.Count - 1
                    Application.DoEvents()
                    DGV.Rows.Add(IIf(i = 0, 1, i + 1), .Rows(i).Cells("NIK").Value, _
                                 .Rows(i).Cells("Nama").Value, .Rows(i).Cells("Alamat").Value, _
                                 .Rows(i).Cells("Telp").Value)
                Next
            End If
        End With

        FlNm = "E:\Student " & Now.Day & "-" & Now.Month & "-" & Now.Year & ".xls"
        'FlNm = Application.StartupPath & "\Student " _
        '        & Now.Day & "-" & Now.Month & "-" & Now.Year & ".xls"
        If File.Exists(FlNm) Then File.Delete(FlNm)
        ExportToExcel(DGV)

        DGV.Dispose()
        DGV = Nothing

        Process.Start("E:\Student " & Now.Day & "-" & Now.Month & "-" & Now.Year & ".xls")

        BtnExport.Text = "Export"
        BtnExport.Enabled = True

    End Sub

End Class


الملفات المرفقة
.txt   Very Fast Method Export DataGridView To Excel With VB.Net.txt (الحجم : 6.84 ك ب / التحميلات : 18)
الرد }}}
تم الشكر بواسطة:
#2
(09-02-22, 09:57 PM) pid=\180502' كتب :       Try' استيراد من الإكسل
            DGV.Rows.Clear()
            Dim OFD As New OpenFileDialog
            OFD.Filter = "Excel Files|*.xlsx|Excel 2003|*.xls"
            OFD.Title = (" استيراد البيانات من الورقة الأولى من السطر الثاني في ملف الإكسل")
            If OFD.ShowDialog = Windows.Forms.DialogResult.OK Then
                BTN_EX_IMP.Text = "يرجى الانتظار"
                BTN_EX_IMP.BackColor = Color.Tomato
                BTN_EX_IMP.Enabled = False
                DGV.DataSource = Nothing
                Dim PATH_ As String = OFD.FileName
                Dim CON__ As New OleDbConnection("PROVIDER=MICROSOFT.ACE.OLEDB.12.0;DATA SOURCE=" & PATH_ & "; EXTENDED PROPERTIES=EXCEL 12.0;")
                'Dim ds As New DataSet
                Dim da As New OleDbDataAdapter("SELECT * FROM [1$]", CON__)
                'da.Fill(ds, "[1$]")
                'DGV.DataSource = ds.Tables("[1$]")
                Dim DT As New DataTable
                DT.Clear()
                da.Fill(DT)
                Dim COUNT_ As Integer = 0 'تعريف متغير للوب
                If DT.Rows.Count > 0 Then
                    DGV.RowCount = DT.Rows.Count + 1 ' مهم جدا عدد الاسطر في الداتاجريد تساوي عدد الاسطر في الداتاتيبل ويضيف سطر
                    For I As Integer = 0 To DT.Rows.Count - 1 ' تعبئة الداتاجريد بحيث يمر على الداتا تيبل بلوب
                        DGV.Rows(COUNT_).Cells(3).Value = DT.Rows(I)(0).ToString
                        DGV.Rows(COUNT_).Cells(4).Value = DT.Rows(I)(1).ToString
                        DGV.Rows(COUNT_).Cells(5).Value = DT.Rows(I)(2).ToString
                        DGV.Rows(COUNT_).Cells(6).Value = DT.Rows(I)(3).ToString
                        DGV.Rows(COUNT_).Cells(7).Value = DT.Rows(I)(4).ToString
                        DGV.Rows(COUNT_).Cells(8).Value = DT.Rows(I)(5).ToString
                        DGV.Rows(COUNT_).Cells(9).Value = DT.Rows(I)(6).ToString
                        DGV.Rows(COUNT_).Cells(10).Value = DT.Rows(I)(7).ToString
                        DGV.Rows(COUNT_).Cells(11).Value = DT.Rows(I)(8).ToString
                        DGV.Rows(COUNT_).Cells(12).Value = DT.Rows(I)(9).ToString
                        DGV.Rows(COUNT_).Cells(13).Value = DT.Rows(I)(10).ToString
                        DGV.Rows(COUNT_).Cells(14).Value = DT.Rows(I)(11).ToString
                        DGV.Rows(COUNT_).Cells(15).Value = DT.Rows(I)(12).ToString
                        DGV.Rows(COUNT_).Cells(16).Value = DT.Rows(I)(13).ToString
                        DGV.Rows(COUNT_).Cells(17).Value = DT.Rows(I)(14).ToString
                        DGV.Rows(COUNT_).Cells(18).Value = DT.Rows(I)(15).ToString
                        DGV.Rows(COUNT_).Cells(19).Value = DT.Rows(I)(16).ToString
                        DGV.Rows(COUNT_).Cells(20).Value = DT.Rows(I)(17).ToString
                        COUNT_ += 1 ' بما أنه بدأ من السطر0 نزيده واحد في كل لوب
                    Next
                End If
            Else
                End
            End If
            BTN_EX_IMP.Text = "استيراد من إكسل"
            BTN_EX_IMP.Enabled = True
            BTN_EX_IMP.BackColor = Color.Transparent
        Catch ex As Exception
            MessageBox.Show(ex.ToString)
        End Try




'===========================================


    Public Shared Sub SaveGridToExcel(ByVal DGV As DataGridView) ' صب نسخ من الجريد لإكسل
        Try
            Dim XCELAPP As Microsoft.Office.Interop.Excel.Application = Nothing
            Dim XWORKBOOK As Microsoft.Office.Interop.Excel.Workbook = Nothing
            Dim XSHEET As Microsoft.Office.Interop.Excel.Worksheet = Nothing
            Dim misValue As Object = System.Reflection.Missing.Value
            If DGV.Rows.Count > 0 Then
                Dim filename As String = ""
                Dim SV As New SaveFileDialog()
                SV.Filter = "Excel Files|*.xlsx|Excel 2003|*.xls"

                If SV.ShowDialog = DialogResult.OK Then
                    If DGV.RightToLeft = RightToLeft.Yes Then
                        DGV.RightToLeft = False 'تغيير اتجاه الجريد من اليمين لليسار لكي لا ينسخ بالمقلوب
                        filename = SV.FileName
                        Dim multiselect As Boolean = DGV.MultiSelect
                        DGV.MultiSelect = True
                        DGV.SelectAll()
                        DGV.ClipboardCopyMode = DataGridViewClipboardCopyMode.EnableAlwaysIncludeHeaderText
                        Clipboard.SetDataObject(DGV.GetClipboardContent())
                        Dim results = System.Convert.ToString(Clipboard.GetData(DataFormats.Text))
                        DGV.ClearSelection()
                        DGV.MultiSelect = multiselect
                        DGV.RightToLeft = RightToLeft.Yes ' ارجاع اتجاه الجريد لليمين
                        XCELAPP = New Excel.Application()
   
                        XWORKBOOK = XCELAPP.Workbooks.Add(misValue)
                        XCELAPP.DisplayAlerts = False
                        XCELAPP.Visible = False
                        XSHEET = XWORKBOOK.ActiveSheet
                        XSHEET.DisplayRightToLeft = True
                        XSHEET.PasteSpecial(RightToLeft.Yes)
                        XWORKBOOK.SaveAs(filename, Excel.XlFileFormat.xlOpenXMLWorkbook)
                        XWORKBOOK.Close(False)
                        XCELAPP.Quit()
                    Else
                        filename = SV.FileName
                        Dim multiselect As Boolean = DGV.MultiSelect
                        DGV.MultiSelect = True
                        DGV.SelectAll()
                        DGV.ClipboardCopyMode = DataGridViewClipboardCopyMode.EnableAlwaysIncludeHeaderText
                        Clipboard.SetDataObject(DGV.GetClipboardContent())
                        Dim results = System.Convert.ToString(Clipboard.GetData(DataFormats.Text))
                        DGV.ClearSelection()
                        DGV.MultiSelect = multiselect
                        XCELAPP = New Excel.Application()
                        XWORKBOOK = XCELAPP.Workbooks.Add(misValue)
                        XCELAPP.DisplayAlerts = False
                        XCELAPP.Visible = False
                        XSHEET = XWORKBOOK.ActiveSheet
                        XSHEET.Paste()
                        XWORKBOOK.SaveAs(filename, Excel.XlFileFormat.xlOpenXMLWorkbook)
                        XWORKBOOK.Close(False)
                        XCELAPP.Quit()
                    End If

                    If MessageBox.Show("هل تريد فتح الملف ؟", "فتح ملف الأكسل", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1, MessageBoxOptions.RtlReading) = MsgBoxResult.Yes Then
                        Process.Start(SV.FileName)
                    End If
                    Try
                        System.Runtime.InteropServices.Marshal.ReleaseComObject(XSHEET)
                        System.Runtime.InteropServices.Marshal.ReleaseComObject(XWORKBOOK)
                        System.Runtime.InteropServices.Marshal.ReleaseComObject(XCELAPP)
                    Catch
                    End Try
                End If
            End If

        Catch ex As Exception
            MessageBox.Show(ex.ToString)
        End Try
    End Sub
    Private Sub BTN_EXCEL_COPY_Click(sender As Object, e As EventArgs) Handles BTN_EXCEL_COPY.Click 'زر التصدير
        SaveGridToExcel(DGV)
    End Sub


الملفات المرفقة
.txt   IMPORT AND EXPORT TO EXCEL (2).txt (الحجم : 7.74 ك ب / التحميلات : 31)
الرد }}}
تم الشكر بواسطة:


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  [VB.NET] جملة اتصال بملف اكسيل ٢٠٠٣ بكلمة مرور Mr.H 3 68 منذ 7 ساعة مضت
آخر رد: Amir_Alzubidy
  [VB.NET] حل مشكلة الاتصال بقواعد البيانات access loay775 2 158 25-02-24, 06:29 AM
آخر رد: loay775
  سؤال عن عملية حذف سجل من قاعدة البيانات assuhimi 3 249 11-02-24, 08:43 PM
آخر رد: assuhimi
  [VB.NET] منع تكرار البيانات في عند الادخال مبرمج صغير 1 2 255 24-01-24, 05:18 PM
آخر رد: مبرمج صغير 1
  [VB.NET] مساعدة في استدعاء البيانات معينه من form الأول إلى form 2 بدون التعديل loay775 2 275 18-01-24, 05:04 PM
آخر رد: loay775
  [VB.NET] إعادة استدعاء البيانات من قاعدة بيانات اكسس والاهم الصورة مبرمج صغير 1 1 273 13-01-24, 01:17 PM
آخر رد: مبرمج صغير 1
  اريد طباعة الباركود المحدد فقط مع الكمية new_programer 5 431 09-01-24, 08:40 PM
آخر رد: new_programer
  اريد مساعدة في العملية الحسابية melad2002 3 406 29-12-23, 09:10 PM
آخر رد: melad2002
  [كود] اريد كود إرسال البيانات من الفيجوال بيسك إلىPDF issamsaidd 10 5,829 25-12-23, 06:30 PM
آخر رد: الحزين اليماني
  جملة الاتصال بقاعدة البيانات اكسس محمد خيري 4 364 12-12-23, 03:14 AM
آخر رد: محمد خيري

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


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