تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
مساعدة
#4

غير ما يجب تغييره كاسم الداتا جريد فيو و كذلك نطاق البيانات الذي تحتاجه على شيت الإكسل
كود :
  Private Sub Button7_Click(sender As Object, e As EventArgs) Handles Button7.Click
       Export_Dat_Excel(DGV_CINQUIEME)
   End Sub
   Private Sub Export_Dat_Excel(ByVal st As Object)
       If DGV_CINQUIEME.RowCount = Nothing Then
           MessageBox.Show("المعذرة .. لا توجد بيانات لتصديرها إلى ملف الإكسل" & vbCrLf & "الرّجاء التأكد من جلب البيانات على الشبكة", "", MessageBoxButtons.OK, MessageBoxIcon.Error)
           Exit Sub
       ElseIf ((DGV_CINQUIEME.Columns.Count = 0) Or (DGV_CINQUIEME.Rows.Count = 0)) Then
           Exit Sub
       ElseIf Not Directory.Exists("C:\وثيقة الإكسل لمترشّحي شهادة نهاية مرحلة التّعليم الإبتدائي") Then
           Directory.CreateDirectory("C:\وثيقة الإكسل لمترشّحي شهادة نهاية مرحلة التّعليم الإبتدائي")
       Else
           Dim rowsTotal, colsTotal As Short
           Dim I, j, iC As Short
           System.Windows.Forms.Cursor.Current = System.Windows.Forms.Cursors.WaitCursor
           Dim xlApp As New Excel.Application
           Try
               Dim excelBook As Excel.Workbook = xlApp.Workbooks.Add
               Dim excelWorksheet As Excel.Worksheet = CType(excelBook.Worksheets(1), Excel.Worksheet)
               xlApp.Visible = False
               rowsTotal = st.RowCount
               colsTotal = st.Columns.Count - 1
               With excelWorksheet
                   .Cells.Select()
                   .Cells.Delete()
                   For iC = 0 To colsTotal
                       .Cells(1, iC + 1).Value = st.Columns(iC).HeaderText
                   Next
                   For I = 0 To rowsTotal - 1
                       For j = 0 To colsTotal
                           .Cells(I + 2, j + 1).value = st.Rows(I).Cells(j).Value
                       Next j
                   Next I
                   .Rows("1:1").Style.Font.Name = "Times New Roman"
                   .Rows("1:1").Font.FontStyle = "Bold"
                   .Rows("1:1").Font.Size = 12
                   .Rows("1:1").Font.Color = Color.Red
                   .Columns.HorizontalAlignment = 3
                   .Cells(j + 1).ColumnWidth = 10
                   .Cells.Columns.AutoFit()
                   .Cells.Select()
                   .Cells.EntireColumn.AutoFit()
                   .Cells(1, 1).Select()

                   excelWorksheet.Range("A2:R1000").Interior.Color = System.Drawing.ColorTranslator.ToOle(System.Drawing.Color.Azure)
                   excelWorksheet.Range("A2", "R1000").Font.Bold = True
                   excelWorksheet.DisplayRightToLeft = True

                   excelWorksheet.Columns("A:A").ColumnWidth = 6
                   excelWorksheet.Columns("B:B").ColumnWidth = 9
                   excelWorksheet.Columns("C:C").ColumnWidth = 12
                   excelWorksheet.Columns("E:E").ColumnWidth = 20
                   excelWorksheet.Columns("F:F").ColumnWidth = 20
                   excelWorksheet.Columns("G:G").ColumnWidth = 14
                   excelWorksheet.Columns("R:R").ColumnWidth = 14

               End With
               excelWorksheet.SaveAs("C:\وثيقة الإكسل لمترشّحي شهادة نهاية مرحلة التّعليم الإبتدائي\CINQUIEME" & DateAndTime.Now.ToString("@dd-MM-yyyy@HH-mm-ss") & ".xlsx")
               MDIParent1.Snds.Play("Note B")
               MsgBox("تمّ تصدير البيانات إلى ملف الإكسل بنجاح")
               excelBook.Close()
               xlApp.Quit()
           Catch ex As Exception
               MessageBox.Show(ex.Message, "خطأ غير متوقّع", MessageBoxButtons.OK, MessageBoxIcon.Error)
           Finally
               System.Windows.Forms.Cursor.Current = System.Windows.Forms.Cursors.Default
               xlApp = Nothing
           End Try
       End If
   End Sub
تحياتي
قناتنا على اليوتوب
الرد }}}
تم الشكر بواسطة: alshandodi , asemshahen5


الردود في هذا الموضوع
مساعدة - بواسطة alshandodi - 19-02-20, 09:16 PM
RE: مساعدة - بواسطة bidaya - 19-02-20, 09:31 PM
RE: مساعدة - بواسطة alshandodi - 19-02-20, 09:44 PM
RE: مساعدة - بواسطة عبد العزيز البسكري - 19-02-20, 10:47 PM
RE: مساعدة - بواسطة alshandodi - 20-02-20, 12:07 AM
RE: مساعدة - بواسطة عبد العزيز البسكري - 20-02-20, 01:12 AM
RE: مساعدة - بواسطة alshandodi - 20-02-20, 07:22 AM


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


يقوم بقرائة الموضوع: