المشاركات : 2,643
المواضيع 204
الإنتساب : Dec 2015
السمعة :
332
الشكر: 17134
تم شكره 11145 مرات في 2627 مشاركات
21-02-20, 08:01 PM
(آخر تعديل لهذه المشاركة : 21-02-20, 10:11 PM {2} بواسطة عبد العزيز البسكري.)
السّلام عليكم و رحمة الله و بركاته
إخواني الأفاضل .. جمعة مباركة للجميع
عسى أن تكونوا كلّكم بتمام الصحّة و العافية و راحة البال
رغبة منّي في وضع كود الطباعة بالموديل و أستعمله في العديد من المرّات بجميع الفورمات دون الحاجة إلى كتابته كل مرّة بالفورم و أكتفي فقط باستدعائه ..
كود :
Public Sub Globale_Crystal_Print_Preview_Report(ByVal Sql_String As String, ByVal Report_Name As String, ByVal Table_Name As String)
Cursor.Current = Cursors.WaitCursor
Dim Rpt As New ReportDocument
Dim crtableLogoninfo As New TableLogOnInfo
Dim crConnectionInfo As New ConnectionInfo
Dim CrTables As Tables
Try
Dim MyReportPath As String = Application.StartupPath & "\FolderReport\" & Report_Name & ".Rpt"
Rpt.Load(MyReportPath)
With crConnectionInfo
.ServerName = Application.StartupPath & "\ABDELAZIZ.Mdb"
.DatabaseName = Application.StartupPath & "\ABDELAZIZ.Mdb"
.UserID = "Admin"
.Password = "XZ987654SW"
End With
CrTables = Rpt.Database.Tables
For Each CrTable In CrTables
crtableLogoninfo = CrTable.LogOnInfo
crtableLogoninfo.ConnectionInfo = crConnectionInfo
CrTable.ApplyLogOnInfo(crtableLogoninfo)
Next
If Conne_2020.State = ConnectionState.Closed Then Conne_2020.Open()
Dim Adp = New OleDb.OleDbDataAdapter(Sql_String, Conne_2020)
Dim Ds As DataSet = New DataSet()
Adp.Fill(Ds, Table_Name)
Dim Dt = Ds.Tables(0)
If Dt.Rows.Count = 0 Then
XtraMessageBox.Show("لم يتم العثور على بيانات لعرضها في التّقرير", "طباعة التقرير", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Cursor.Current = Cursors.Default
Exit Sub
Else
Rpt.SetDataSource(Ds)
Dim Frm As New FrmCrystalPrinting
Frm.CrystalReportViewer1.ReportSource = Rpt
Frm.CrystalReportViewer1.Zoom(100%)
Frm.CrystalReportViewer1.Refresh()
Frm.ShowDialog()
End If
If Conne_2020.State = ConnectionState.Open Then Conne_2020.Close()
Rpt.Close()
Rpt.Dispose()
Catch ex As Exception
XtraMessageBox.Show("خطأ غير متوقّع في عمليّة جلب البيانات", "طباعة التقرير")
End Try
End Sub
كود الإستدعاء و الطباعة ..
كود :
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Call Globale_Crystal_Print_Preview_Report("SELECT * From TBL_STUDENT", "Crystal1", "TBL_STUDENT")
End Sub
إلى هنا .. الأمور تسير على أحسن وجه .. و بدون أي إلتباسات
المشكلة إخواني الأعزّاء ..
أحيانا أحتاج لإضافة عناوين خاصّة بتمرير قيمة تاكست بكس من الفورم إلى صفحة التّقرير
بواسطة كود تمرير القيم إلى التّقرير
كود :
Dim Text1 As CrystalDecisions.CrystalReports.Engine.TextObject = Rpt.Section2.ReportObjects("Text1")
Text1.Text = Me.TextBox1.Text
Dim Text2 As CrystalDecisions.CrystalReports.Engine.TextObject = Rpt.Section2.ReportObjects("Text2")
Text2.Text = Me.TextBox2.Text
على أساس Text1 و Text2 هي من نوع TextObject الخاصة بالكريستال ريبورت
طبعا من المفروض بالطباعة العادية من خلال الفورم .. يكون الكود بهذا الشكل ..
كود :
If Dt.Rows.Count = 0 Then
XtraMessageBox.Show("لم يتم العثور على بيانات لعرضها في التّقرير", "طباعة التقرير", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Cursor.Current = Cursors.Default
Exit Sub
Else
Rpt.SetDataSource(Ds)
Dim Text1 As CrystalDecisions.CrystalReports.Engine.TextObject = Rpt.Section2.ReportObjects("Text1")
Text1.Text = Me.TextBox1.Text
Dim Text2 As CrystalDecisions.CrystalReports.Engine.TextObject = Rpt.Section2.ReportObjects("Text2")
Text2.Text = Me.TextBox2.Text
Dim Frm As New FrmCrystalPrinting
Frm.CrystalReportViewer1.ReportSource = Rpt
Frm.CrystalReportViewer1.Zoom(100%)
Frm.CrystalReportViewer1.Refresh()
Frm.ShowDialog()
ما أطلبه .. فضل و كرم و إحسان منكم هو ..
كيف أدمج هذيْن السطريْن أعلاه و أضيفهما على كود الطباعة بالموديل و أتحكم بتسميات التاكسات بوكس التي أريد إضفة قيمها لصفحة الكريستال ريبورت
بارك الله فيكم و لكم و جزاكم خير الجزاء مقدما
تحياتي واحتراماتي
المشاركات : 260
المواضيع 0
الإنتساب : Jan 2020
السمعة :
41
الشكر: 0
تم شكره 381 مرات في 213 مشاركات
(21-02-20, 08:01 PM)عبد العزيز البسكري كتب : السّلام عليكم و رحمة الله و بركاته
إخواني الأفاضل .. جمعة مباركة للجميع
عسى أن تكونوا كلّكم بتمام الصحّة و العافية و راحة البال
رغبة منّي في وضع كود الطباعة بالموديل و أستعمله في العديد من المرّات بجميع الفورمات دون الحاجة إلى كتابته كل مرّة بالفورم و أكتفي فقط باستدعائه ..
كود :
Public Sub Globale_Crystal_Print_Preview_Report(ByVal Sql_String As String, ByVal Report_Name As String, ByVal Table_Name As String)
Cursor.Current = Cursors.WaitCursor
Dim Rpt As New ReportDocument
Dim crtableLogoninfo As New TableLogOnInfo
Dim crConnectionInfo As New ConnectionInfo
Dim CrTables As Tables
Try
Dim MyReportPath As String = Application.StartupPath & "\FolderReport\" & Report_Name & ".Rpt"
Rpt.Load(MyReportPath)
With crConnectionInfo
.ServerName = Application.StartupPath & "\ABDELAZIZ.Mdb"
.DatabaseName = Application.StartupPath & "\ABDELAZIZ.Mdb"
.UserID = "Admin"
.Password = "XZ987654SW"
End With
CrTables = Rpt.Database.Tables
For Each CrTable In CrTables
crtableLogoninfo = CrTable.LogOnInfo
crtableLogoninfo.ConnectionInfo = crConnectionInfo
CrTable.ApplyLogOnInfo(crtableLogoninfo)
Next
If Conne_2020.State = ConnectionState.Closed Then Conne_2020.Open()
Dim Adp = New OleDb.OleDbDataAdapter(Sql_String, Conne_2020)
Dim Ds As DataSet = New DataSet()
Adp.Fill(Ds, Table_Name)
Dim Dt = Ds.Tables(0)
If Dt.Rows.Count = 0 Then
XtraMessageBox.Show("لم يتم العثور على بيانات لعرضها في التّقرير", "طباعة التقرير", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Cursor.Current = Cursors.Default
Exit Sub
Else
Rpt.SetDataSource(Ds)
Dim Frm As New FrmCrystalPrinting
Frm.CrystalReportViewer1.ReportSource = Rpt
Frm.CrystalReportViewer1.Zoom(100%)
Frm.CrystalReportViewer1.Refresh()
Frm.ShowDialog()
End If
If Conne_2020.State = ConnectionState.Open Then Conne_2020.Close()
Rpt.Close()
Rpt.Dispose()
Catch ex As Exception
XtraMessageBox.Show("خطأ غير متوقّع في عمليّة جلب البيانات", "طباعة التقرير")
End Try
End Sub
كود الإستدعاء و الطباعة ..
كود :
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Call Globale_Crystal_Print_Preview_Report("SELECT * From TBL_STUDENT", "Crystal1", "TBL_STUDENT")
End Sub
إلى هنا .. الأمور تسير على أحسن وجه .. و بدون أي إلتباسات
المشكلة إخواني الأعزّاء ..
أحيانا أحتاج لإضافة عناوين خاصّة بتمرير قيمة تاكست بكس من الفورم إلى صفحة التّقرير
بواسطة كود تمرير القيم إلى التّقرير
كود :
Dim Text1 As CrystalDecisions.CrystalReports.Engine.TextObject = Rpt.Section2.ReportObjects("Text1")
Text1.Text = Me.TextBox1.Text
Dim Text2 As CrystalDecisions.CrystalReports.Engine.TextObject = Rpt.Section2.ReportObjects("Text2")
Text2.Text = Me.TextBox2.Text
على أساس Text1 و Text2 هي من نوع TextObject الخاصة بالكريستال ريبورت
طبعا من المفروض بالطباعة العادية من خلال الفورم .. يكون الكود بهذا الشكل ..
كود :
If Dt.Rows.Count = 0 Then
XtraMessageBox.Show("لم يتم العثور على بيانات لعرضها في التّقرير", "طباعة التقرير", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Cursor.Current = Cursors.Default
Exit Sub
Else
Rpt.SetDataSource(Ds)
Dim Text1 As CrystalDecisions.CrystalReports.Engine.TextObject = Rpt.Section2.ReportObjects("Text1")
Text1.Text = Me.TextBox1.Text
Dim Text2 As CrystalDecisions.CrystalReports.Engine.TextObject = Rpt.Section2.ReportObjects("Text2")
Text2.Text = Me.TextBox2.Text
Dim Frm As New FrmCrystalPrinting
Frm.CrystalReportViewer1.ReportSource = Rpt
Frm.CrystalReportViewer1.Zoom(100%)
Frm.CrystalReportViewer1.Refresh()
Frm.ShowDialog()
ما أطلبه .. فضل و كرم و إحسان منكم هو ..
كيف أدمج هذيْن السطريْن أعلاه و أضيفهما على كود الطباعة بالموديل و أتحكم بتسميات التاكسات بوكس التي أريد إضفة قيمها لصفحة الكريستال ريبورت
بارك الله فيكم و لكم و جزاكم خير الجزاء مقدما
تحياتي واحتراماتي
بما ان الاضافة تتم (احيانا) فاستخدم Optional
عدل تعريف الاجراء
كود :
Public Sub Globale_Crystal_Print_Preview_Report(Sql_String As String, Report_Name As String, Table_Name As String, Optional s1 As String = "", Optional s2 As String = "")
واضف الكود التالي بعد Else
كود :
If s1 <> "" Then
Dim Text1 As CrystalDecisions.CrystalReports.Engine.TextObject = Rpt.Section2.ReportObjects("Text1")
Text1.Text = s1
End If
If s2 <> "" Then
Dim Text2 As CrystalDecisions.CrystalReports.Engine.TextObject = Rpt.Section2.ReportObjects("Text2")
Text2.Text = s2
End If
فيكون الاستدعاء في حالة اضافة عناوين
كود :
Call Globale_Crystal_Print_Preview_Report("SELECT * From TBL_STUDENT", "Crystal1", "TBL_STUDENT", Me.TextBox1.Text, Me.TextBox2.Text)
او كالسابق في حالة لا تريد اضافة عناوين
كود :
Call Globale_Crystal_Print_Preview_Report("SELECT * From TBL_STUDENT", "Crystal1", "TBL_STUDENT")
المشاركات : 2,329
المواضيع 81
الإنتساب : May 2018
السمعة :
522
الشكر: 14039
تم شكره 5671 مرات في 2269 مشاركات
أو أدمج هذا مع كودك :
PHP كود :
Sub LoadTextToCrystalReportText(TextName As ArrayList, TextBoxText As ArrayList) Dim Rpt As New CrystalReport1 Dim i As Integer = 0 For Each str0 As String In TextName Dim Text1 As CrystalDecisions.CrystalReports.Engine.TextObject = Rpt.Section2.ReportObjects(str0) Text1.Text = TextBoxText(i).ToString i += 1 Next CrystalReportViewer1.ReportSource = Rpt CrystalReportViewer1.Zoom(100%) CrystalReportViewer1.Refresh() End Sub
و هذا كود الاستخدام :
PHP كود :
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click Dim TextName As New ArrayList Dim TextBoxText As New ArrayList TextName.Clear() TextBoxText.Clear() TextName.Add("Text1") TextName.Add("Text2") TextBoxText.Add(TextBox1.Text) TextBoxText.Add(TextBox2.Text) LoadTextToCrystalReportText(TextName, TextBoxText) End Sub
سبحان الله وبحمده سبحان الله العظيم و الحمد لله ولا اله الا الله والله اكبر
المشاركات : 2,643
المواضيع 204
الإنتساب : Dec 2015
السمعة :
332
الشكر: 17134
تم شكره 11145 مرات في 2627 مشاركات
السّلام عليكم و رحمة الله و بركاته
بارك الله فيكما و لكما و جزاكما خير الجزاء
الأخوان الفاضلان :
السلموني
عاصم شاهين
تمّ عمل المطلوب بفضلكما و الحمد لله
تحياتي و تقييماتي
المشاركات : 2,329
المواضيع 81
الإنتساب : May 2018
السمعة :
522
الشكر: 14039
تم شكره 5671 مرات في 2269 مشاركات
الحمد لله و الشكر لله رب العالمين تحياتي لك .
سبحان الله وبحمده سبحان الله العظيم و الحمد لله ولا اله الا الله والله اكبر
المشاركات : 260
المواضيع 0
الإنتساب : Jan 2020
السمعة :
41
الشكر: 0
تم شكره 381 مرات في 213 مشاركات
(21-02-20, 10:05 PM)عبد العزيز البسكري كتب : السّلام عليكم و رحمة الله و بركاته
بارك الله فيكما و لكما و جزاكما خير الجزاء
الأخوان الفاضلان :
السلموني
عاصم شاهين
تمّ عمل المطلوب بفضلكما و الحمد لله
تحياتي و تقييماتي
العفو اخي
المشاركات : 2,643
المواضيع 204
الإنتساب : Dec 2015
السمعة :
332
الشكر: 17134
تم شكره 11145 مرات في 2627 مشاركات
السّلام عليكم و رحمة الله و بركاته
فقط .. من باب الفائدة العامّة
إذا كان عدد التاكسات معلوم و محدّد
قمت بتجربة هذه الطريقة و تشتغل بطريقة رائعة إضافة لطريقتيْ الأستاذين الفاضلين أعلاه
يتم وضع السطرين بالمكان المحدّد مثلما تمّ ذكره سابقًا
تحياتي
المشاركات : 2,329
المواضيع 81
الإنتساب : May 2018
السمعة :
522
الشكر: 14039
تم شكره 5671 مرات في 2269 مشاركات
22-02-20, 10:25 AM
(آخر تعديل لهذه المشاركة : 23-02-20, 05:33 PM {2} بواسطة asemshahen5.)
هذا الكود بعد الدمج :
PHP كود :
Public Sub Globale_Crystal_Print_Preview_Report(ByVal Sql_String As String, ByVal Report_Name As String, ByVal Table_Name As String, TextName As ArrayList, TextBoxText As ArrayList) Cursor.Current = Cursors.WaitCursor Dim Rpt As New ReportDocument Dim crtableLogoninfo As New TableLogOnInfo Dim crConnectionInfo As New ConnectionInfo Dim CrTables As Tables Dim MyReportPath As String = Application.StartupPath & "\FolderReport\" & Report_Name & ".Rpt" Rpt.Load(MyReportPath)' With crConnectionInfo .ServerName = Application.StartupPath & "\ABDELAZIZ.Mdb" .DatabaseName = Application.StartupPath & "\ABDELAZIZ.Mdb" .UserID = "Admin" .Password = "XZ987654SW" End With CrTables = Rpt.Database.Tables For Each CrTable In CrTables crtableLogoninfo = CrTable.LogOnInfo crtableLogoninfo.ConnectionInfo = crConnectionInfo CrTable.ApplyLogOnInfo(crtableLogoninfo) Next If Conne_2020.State = ConnectionState.Closed Then Conne_2020.Open() Dim Adp = New OleDb.OleDbDataAdapter(Sql_String, Conne_2020) Dim Ds As DataSet = New DataSet() Adp.Fill(Ds, Table_Name) Dim Dt = Ds.Tables(0) If Dt.Rows.Count = 0 Then 'XtraMessageBox.Show("لم يتم العثور على بيانات لعرضها في التّقرير", "طباعة التقرير", MessageBoxButtons.OK, MessageBoxIcon.Exclamation) Cursor.Current = Cursors.Default Exit Sub Else Rpt.SetDataSource(Ds) Dim i As Integer = 0 For Each str0 As String In TextName Dim Text1 As CrystalDecisions.CrystalReports.Engine.TextObject = Rpt.ReportDefinition.Sections(2).ReportObjects(str0) Text1.Text = TextBoxText(i).ToString i += 1 Next Dim Frm As New FrmCrystalPrinting Frm.CrystalReportViewer1.ReportSource = Rpt Frm.CrystalReportViewer1.Zoom(100%) Frm.CrystalReportViewer1.Refresh() Frm.ShowDialog() End If If Conne_2020.State = ConnectionState.Open Then Conne_2020.Close() Rpt.Close() Rpt.Dispose() End Sub
كود الاستخدام :
PHP كود :
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click Dim TextName As New ArrayList Dim TextBoxText As New ArrayList TextName.Clear() TextBoxText.Clear() TextName.Add("Text1") TextName.Add("Text2") TextBoxText.Add(TextBox1.Text) TextBoxText.Add(TextBox2.Text) Globale_Crystal_Print_Preview_Report("SELECT * From AccountsTree", "CrystalReport1", "AccountsTree", TextName, TextBoxText) End Sub
هذه الطريقة تستطيع وضع عدد غير محدود من التكست بوكس .
سبحان الله وبحمده سبحان الله العظيم و الحمد لله ولا اله الا الله والله اكبر
المشاركات : 2,329
المواضيع 81
الإنتساب : May 2018
السمعة :
522
الشكر: 14039
تم شكره 5671 مرات في 2269 مشاركات
موفق انشاء الله .
سبحان الله وبحمده سبحان الله العظيم و الحمد لله ولا اله الا الله والله اكبر
المشاركات : 2,643
المواضيع 204
الإنتساب : Dec 2015
السمعة :
332
الشكر: 17134
تم شكره 11145 مرات في 2627 مشاركات
السلام عليكم و رحمة الله و بركاته
أرجو المعذرة أخي و أستاذي الكريم عاصم شاهين .. كثرة الانشغالات و مشاكل الدنيا أنستني الموضوع
فكرة رائعة من انسان أروع
بارك الله فيك و لك و جزاك خير الجزاء و أنعم عليك بالدنيا و بالاخرة بعد عمر طويل ان شاء الله
تحياتي و تقييماتي
|