السلام عليكم ورحمة الله
المشكلة ليس لدي كريستال ريبورت للتجربة
أول شيء عند خطأ في قاعدة البيانات وهي عدم وجود عمود id ويجب إضافته بترقيم تلقائي ومفتاحي
وهو مهم جداً إذا كنت تستخدم الاستعلام المحدد أو الحذف المحدد أو التعديل المحدد
هذا كود Form1 تم تعديله بالكامل تقريباً
PHP كود :
Imports System.Data.OleDb
Public Class Form1
Public connString As String = "Provider=Microsoft.Jet.OleDb.4.0; Data Source=" & Application.StartupPath & "\data.mdb"
#Region " Form1_Load "
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
' تعبئة الداتاجريدفيو '
FillDataGridView()
End Sub
#End Region
' زر طباعة المحدد '
#Region " Button1_Click "
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Me.Cursor = Cursors.WaitCursor
' طباعة المحدد '
PrintSelections()
Me.Cursor = Cursors.Default
End Sub
#End Region
' زر طباعة الكل '
#Region " Button2_Click "
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
Me.Cursor = Cursors.WaitCursor
' طباعة الكل '
PrintAll()
Me.Cursor = Cursors.Default
End Sub
#End Region
' زر حذف المحدد '
#Region " Button3_Click "
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
Me.Cursor = Cursors.WaitCursor
If MsgBox("هل أنت متأكد من الحذف؟", MsgBoxStyle.Question + _
MsgBoxStyle.YesNo + MsgBoxStyle.MsgBoxRtlReading + _
MsgBoxStyle.MsgBoxRight) _
= MsgBoxResult.Yes _
Then
' حذف المحدد '
DeleteSelections()
End If
Me.Cursor = Cursors.Default
End Sub
#End Region
' تعبئة الداتاجريدفيو '
#Region " FillDataGridView() "
Private Sub FillDataGridView()
Try
Using da As New OleDbDataAdapter("SELECT * FROM [persons]", connString)
Using dt As New DataTable
da.Fill(dt)
Me.DataGridView1.DataSource = dt
' بإمكانك إخفاء عمود في الداتاجريدفيو '
''Me.DataGridView1.Columns("id").Visible = False
End Using
End Using
' إضافة عمود تشكبوكس في الداتاجريدفيو '
AddDataGridViewCheckBoxColumn()
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
#End Region
' إضافة عمود تشكبوكس في الداتاجريدفيو '
#Region " AddDataGridViewCheckBoxColumn() "
Private Sub AddDataGridViewCheckBoxColumn()
' إذا وجد عمود تشكبوكس داتاجريدفيو نقوم بحذفه '
If Me.DataGridView1.Columns("printCheckBox") IsNot Nothing Then
Me.DataGridView1.Columns.Remove("printCheckBox")
End If
' إنشاء عمود تشكبوكس داتاجريدفيو '
Dim clmCheckBox As New DataGridViewCheckBoxColumn
' تسمية العمود لاستخدامه بالاسم '
clmCheckBox.Name = "printCheckBox"
' تسمية رأس العمود '
clmCheckBox.HeaderText = "اختر للطباعة"
' إضافة العمود إلى داتاجريدفيو '
Me.DataGridView1.Columns.Add(clmCheckBox)
End Sub
#End Region
' طباعة المحدد '
#Region " PrintSelections() "
Private Sub PrintSelections()
Try
' جملة الاستعلام '
Dim sqlString As String = SqlSelectDataGridViewChecked()
If sqlString <> "" Then
Using da As New OleDbDataAdapter(sqlString, connString)
Using dt As New DataTable
da.Fill(dt)
' الفورم 2 '
Form2.print(dt)
Form2.ShowDialog()
End Using
End Using
ClearDataGridViewCheckBox()
End If
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
#End Region
' تجهيز جملة الاستعلام '
#Region " SqlSelectDataGridViewChecked() As String "
Private Function SqlSelectDataGridViewChecked() As String
' تجهيز الجزء الأول من جملة الاستعلام '
Dim sqlString As String = "SELECT * FROM [persons] "
' تجميع الأسطر عن طريق تشيكبوكس '
Dim w As New List(Of String)
For Each r As DataGridViewRow In Me.DataGridView1.Rows
If r.Cells("printCheckBox").Value = True Then
w.Add(" ([id] = " & r.Cells("id").Value & ") ")
End If
Next
' تجميع بقية جملة الاستعلام '
sqlString &= " WHERE " & Join(w.ToArray, " OR ") & " ORDER BY [id] "
If w.Count > 0 Then Return sqlString
End Function
#End Region
' إفراغ تشيكبوكس '
#Region " ClearDataGridViewCheckBox() "
Private Sub ClearDataGridViewCheckBox()
For Each r As DataGridViewRow In Me.DataGridView1.Rows
r.Cells("printCheckBox").Value = False
Next
End Sub
#End Region
' طباعة الكل '
#Region " PrintAll() "
Private Sub PrintAll()
Try
Using da As New OleDbDataAdapter("SELECT * FROM [persons]", connString)
Using dt As New DataTable
da.Fill(dt)
' الفورم 2 '
Form2.print(dt)
Form2.ShowDialog()
End Using
End Using
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
#End Region
' حذف المحدد '
#Region " DeleteSelections() "
Private Sub DeleteSelections()
Try
' جملة الحذف '
Dim sqlString As String = SqlDeleteDataGridViewChecked()
If sqlString <> "" Then
Using conn As New OleDbConnection(connString)
Using cmd As New OleDbCommand(sqlString, conn)
' تنفيذ الحذف '
conn.Open()
cmd.ExecuteNonQuery()
conn.Close()
End Using
End Using
' تعبئة الداتاجريدفيو '
FillDataGridView()
End If
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
#End Region
' تجهيز جملة الحذف '
#Region " SqlDeleteDataGridViewChecked() As String "
Private Function SqlDeleteDataGridViewChecked() As String
Try
' تجهيز الجزء الأول من جملة الاستعلام '
Dim sqlString As String = "DELETE FROM [persons] "
' تجميع الأسطر عن طريق تشيك بوكس '
Dim w As New List(Of String)
For Each r As DataGridViewRow In Me.DataGridView1.Rows
If r.Cells("printCheckBox").Value = True Then
w.Add(" ([id] = " & r.Cells("id").Value & ") ")
End If
Next
' عكسنا الترتيب لأن الحلقة تبدأ بالعكس '
w.Reverse()
' تجميع بقية جملة الاستعلام '
sqlString &= " WHERE " & Join(w.ToArray, " OR ")
If w.Count > 0 Then Return sqlString
Catch ex As Exception
End Try
End Function
#End Region
End Class
هذا كود Form2 تم تعديله
PHP كود :
Public Class Form2
Public Sub print(ByVal dt As DataTable)
Dim rpt As New CrystalReport1
rpt.SetDataSource(dt)
CrystalReportViewer1.ReportSource = rpt
End Sub
End Class

