[محمد اسماعيل]

السلام عليكم

الكود دة حلقة تكرارية لتصدير كل بيانات الداتا جريد فيو لتصديرها للاكسيل

كود :

 rowsTotal = DATAG.RowCount - 1
           colsTotal = DATAG_.Columns.Count - 1

           With excelWorksheet
               .Cells.Select()
               .Cells.Delete()
               For iC = 0 To colsTotal - 1
                   .Cells(1, iC + 1).Value = DATAG_.Columns(iC).HeaderText
               Next

               For I = 0 To rowsTotal
                   For j = 0 To colsTotal - 1
                       .Cells(I + 2, j + 1).value = DATAG_.Rows(I).Cells(j).Value
                   Next j
               Next I

               .Cells.Columns.AutoFit()
               .Cells.Select()
               .Cells.EntireColumn.AutoFit()
               .Cells(1, 1).Select()
           End With

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

عدلت الجزء التالي ولم يقم بالمطلوب

كود :

rowsTotal = DATAG_CLIENONLIN.SelectedRows.Count

[asemshahen5]

أضف عامود للداتاغريد يكون من نوع تشك بوكسل ليكن رقم 0 ثم ضع عدل السطور التالية :

كود :

For I = 0 To rowsTotal
    For j = 1 To colsTotal '- 1
        If DATAG.Rows(I).Cells(0).Value = True Then
           .Cells(I + 2, j + 1).value = DATAG.Rows(I).Cells(j).Value
        End If
    Next j
Next I

[محمد اسماعيل]

(14-10-18, 06:55 AM)asemshahen5 كتب : أضف عامود للداتاغريد يكون من نوع تشك بوكسل ليكن رقم 0 ثم ضع عدل السطور التالية :

كود :

For I = 0 To rowsTotal
    For j = 1 To colsTotal '- 1
        If DATAG.Rows(I).Cells(0).Value = True Then
           .Cells(I + 2, j + 1).value = DATAG.Rows(I).Cells(j).Value
        End If
    Next j
Next I

انا من نفس فكرتك قمت بالكود دة و

كود :

   For I = 0 To rowsTotal
                   For j = 0 To colsTotal - 1
                       If .Rows(I).Cells(0).Selected = True Then
DATAG.Cells(I + 2, j + 1).value = DATAG.Rows(I).Cells(j).Value
                       End If
                   Next j
               Next I

اشتغل بس المشكلة ان الصفوف غير محددة بتظهر فارغة بالاكسيل عايز ارجع امسح الغير محدد

[asemshahen5]

ما إلك غير تصدر السجلات المحددة لجدول جديد أو DataTable من ثم لاكسيل .

[محمد اسماعيل]

(14-10-18, 09:16 PM)asemshahen5 كتب : ما إلك غير تصدر السجلات المحددة لجدول جديد أو DataTable من ثم لاكسيل .

تعبتك معايا طيب اصدرها ازاي من  DataTable

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

[asemshahen5]

كود :

Public Sub ExportToExcel_DT(ByVal dtTemp As System.Data.DataTable, ByVal FilePath As String)
       If IO.File.Exists(FilePath) Then
           If MsgBox("الملف موجود مسبقا هل تريد حذفه", MsgBoxStyle.YesNo, "ملف موجود") = MsgBoxResult.Yes Then
               IO.File.Delete(FilePath)
           Else
               Return
           End If
       End If
       Dim _Excel As New Excel.Application
       Dim WBook As Excel.Workbook
       Dim WSheet As Excel.Worksheet
       WBook = _Excel.Workbooks.Add
       WSheet = WBook.ActiveSheet
       WSheet.DisplayRightToLeft = True
       Dim DT As System.Data.DataTable = dtTemp
       Dim DC As DataColumn
       Dim DR As DataRow
       Dim ColIndex As Integer = 0
       Dim RowIndex As Integer = 0
       For Each DC In DT.Columns
           ColIndex = ColIndex + 1
           WSheet.Cells(1, ColIndex) = DC.ColumnName
       Next
       For Each DR In DT.Rows
           RowIndex = RowIndex + 1
           ColIndex = 0
           For Each DC In DT.Columns
               ColIndex = ColIndex + 1
               WSheet.Cells(RowIndex + 1, ColIndex) = DR(DC.ColumnName)
               '-------------------------------------------------------
               '-------------------------------------------------------
           Next
       Next
       WSheet.Columns.AutoFit()
       WBook.SaveAs(FilePath)
       WSheet = Nothing
       WBook.Close(False)
       WBook = Nothing
       _Excel.Quit()
       _Excel = Nothing
       GC.Collect()
       MsgBox("تمت عملية تصدير البيانات الى اكسل بنجاح", MsgBoxStyle.Information, "نجاح التصدير")
   End Sub

---

كود :

Dim StrPath As String = "D:\Excel.xlsx"
If dt.Rows.Count > 0 Then
     ExportToExcel_DT(dt, StrPath)
End If

[محمد اسماعيل]

(15-10-18, 12:35 AM)asemshahen5 كتب :

كود :

Public Sub ExportToExcel_DT(ByVal dtTemp As System.Data.DataTable, ByVal FilePath As String)
       If IO.File.Exists(FilePath) Then
           If MsgBox("الملف موجود مسبقا هل تريد حذفه", MsgBoxStyle.YesNo, "ملف موجود") = MsgBoxResult.Yes Then
               IO.File.Delete(FilePath)
           Else
               Return
           End If
       End If
       Dim _Excel As New Excel.Application
       Dim WBook As Excel.Workbook
       Dim WSheet As Excel.Worksheet
       WBook = _Excel.Workbooks.Add
       WSheet = WBook.ActiveSheet
       WSheet.DisplayRightToLeft = True
       Dim DT As System.Data.DataTable = dtTemp
       Dim DC As DataColumn
       Dim DR As DataRow
       Dim ColIndex As Integer = 0
       Dim RowIndex As Integer = 0
       For Each DC In DT.Columns
           ColIndex = ColIndex + 1
           WSheet.Cells(1, ColIndex) = DC.ColumnName
       Next
       For Each DR In DT.Rows
           RowIndex = RowIndex + 1
           ColIndex = 0
           For Each DC In DT.Columns
               ColIndex = ColIndex + 1
               WSheet.Cells(RowIndex + 1, ColIndex) = DR(DC.ColumnName)
               '-------------------------------------------------------
               '-------------------------------------------------------
           Next
       Next
       WSheet.Columns.AutoFit()
       WBook.SaveAs(FilePath)
       WSheet = Nothing
       WBook.Close(False)
       WBook = Nothing
       _Excel.Quit()
       _Excel = Nothing
       GC.Collect()
       MsgBox("تمت عملية تصدير البيانات الى اكسل بنجاح", MsgBoxStyle.Information, "نجاح التصدير")
   End Sub

---

كود :

Dim StrPath As String = "D:\Excel.xlsx"
If dt.Rows.Count > 0 Then
     ExportToExcel_DT(dt, StrPath)
End If

اعجز عن الشكر اخي asemshahen5

يسرا اللَّه لك أمرك في الدنيا والأخرة

[asemshahen5]

الله يسلمك و يحفظك .

[محمد اسماعيل]

(15-10-18, 03:25 AM)asemshahen5 كتب : الله يسلمك و يحفظك .

امين