السلام عليكم اخوتي
كيف يمكنني إضافة مكتبة microsoft.office.interop.excel
فانني لم اجدها في الريفرنس ارجو افادتي بارك الله فيكم
لك جزيل الشكر والتقدير اخي
فلدي سؤال اخر هل يمكن حفظ ملف الإيكسل تلقائي بتاريخ ووقت الحالي بدل لا تظهر نافذة SaveFileDialog
فانا استخدم شرح الإستاذ احمد النجار واستخدم هذا الكود لتصدير الداتا جريد فيو الى الاكسل
كود :
System.Threading.Thread.CurrentThread.CurrentCulture = System.Globalization.CultureInfo.CreateSpecificCulture("en-US")
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("Sheet1")
For colhead As Integer = 0 To DataGridView1.ColumnCount - 1
exlworksheet.Cells(1, colhead + 1) = DataGridView1.Columns(colhead).HeaderText
Next
For i As Integer = 0 To DataGridView1.RowCount - 2
For j As Integer = 0 To DataGridView1.ColumnCount - 1
exlworksheet.Cells(i + 2, j + 1) = DataGridView1.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 MsgBox("هل تريد فتح الملف", MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then
Process.Start(sfd.FileName)
End If
غير ما يجب تغييره كاسم الداتا جريد فيو و كذلك نطاق البيانات الذي تحتاجه على شيت الإكسل
كود :
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
تحياتي
لك جزيل الشكر والتقدير اخي عبدالعزيز
ولكن هناك مشكله إذا قمت بعمل طباعه يحدد حتى الخليه 1000 ويكون بنفس اللون ِ Azure
السلام عليكم و رحمة الله و بركاته
يا غالي ..
أنا ذكرت لك أنّه يجب تغيير ما يجب تغييره
فالأكواد و نطاق البيانات يخصّني أنا .. فقط قم بتغيير ما يلزم تغييره أو إحذف تماما هذه الأجزاء
كود :
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
تحياتي
شكرا جزيلا لكل من ساعدني واشرف على دعمي ولكم مرات عديده جزيل الشكر من اعماق قلبي
