تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
[ تمّ الحل ] : إضافة خاصيّة طباعة التاكست بكود التّقرير
#1
السّلام عليكم و رحمة الله و بركاته
إخواني الأفاضل .. جمعة مباركة للجميع
عسى أن تكونوا كلّكم بتمام الصحّة و العافية و راحة البال
رغبة منّي في وضع كود الطباعة بالموديل و أستعمله في العديد من المرّات بجميع الفورمات دون الحاجة إلى كتابته كل مرّة بالفورم و أكتفي فقط باستدعائه ..
كود :
   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()

ما أطلبه .. فضل و كرم و إحسان منكم هو ..
كيف أدمج هذيْن السطريْن أعلاه و أضيفهما على كود الطباعة بالموديل و أتحكم بتسميات التاكسات بوكس التي أريد إضفة قيمها لصفحة الكريستال ريبورت
بارك الله فيكم و لكم و جزاكم خير الجزاء مقدما
تحياتي واحتراماتي
الرد
تم الشكر بواسطة: محمد كريّم
#2
(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")
الرد
#3
أو أدمج هذا مع كودك :

PHP كود :
   Sub LoadTextToCrystalReportText(TextName As ArrayListTextBoxText 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 ObjectAs EventArgsHandles 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(TextNameTextBoxText)
 
   End Sub 
سبحان الله وبحمده سبحان الله العظيم و الحمد لله ولا اله الا الله والله اكبر




الرد
#4
السّلام عليكم و رحمة الله و بركاته
بارك الله فيكما و لكما و جزاكما خير الجزاء
الأخوان الفاضلان :
السلموني
عاصم شاهين
تمّ عمل المطلوب بفضلكما و الحمد لله

تحياتي و تقييماتي
الرد
تم الشكر بواسطة: asemshahen5 , محمد كريّم , Moneam , Moneam
#5
الحمد لله و الشكر لله رب العالمين تحياتي لك .
سبحان الله وبحمده سبحان الله العظيم و الحمد لله ولا اله الا الله والله اكبر




الرد
#6
(21-02-20, 10:05 PM)عبد العزيز البسكري كتب :
السّلام عليكم و رحمة الله و بركاته
بارك الله فيكما و لكما و جزاكما خير الجزاء
الأخوان الفاضلان :
السلموني
عاصم شاهين
تمّ عمل المطلوب بفضلكما و الحمد لله

تحياتي و تقييماتي

العفو اخي
الرد
#7
السّلام عليكم و رحمة الله و بركاته
فقط .. من باب الفائدة العامّة
إذا كان عدد التاكسات معلوم و محدّد
قمت بتجربة هذه الطريقة و تشتغل بطريقة رائعة إضافة لطريقتيْ الأستاذين الفاضلين أعلاه
يتم وضع السطرين بالمكان المحدّد مثلما تمّ ذكره سابقًا
تحياتي
الرد
تم الشكر بواسطة: asemshahen5 , محمد كريّم , Moneam , Moneam
#8
هذا الكود بعد الدمج :

PHP كود :
   Public Sub Globale_Crystal_Print_Preview_Report(ByVal Sql_String As StringByVal Report_Name As StringByVal Table_Name As StringTextName As ArrayListTextBoxText 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 ObjectAs EventArgsHandles 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"TextNameTextBoxText)
 
   End Sub 

هذه الطريقة تستطيع وضع عدد غير محدود من التكست بوكس .
سبحان الله وبحمده سبحان الله العظيم و الحمد لله ولا اله الا الله والله اكبر




الرد
#9
موفق انشاء الله .
سبحان الله وبحمده سبحان الله العظيم و الحمد لله ولا اله الا الله والله اكبر




الرد
#10
السلام عليكم و رحمة الله و بركاته
أرجو المعذرة أخي و أستاذي الكريم عاصم شاهين .. كثرة الانشغالات و مشاكل الدنيا أنستني الموضوع
فكرة رائعة من انسان أروع
بارك الله فيك و لك و جزاك خير الجزاء و أنعم عليك بالدنيا و بالاخرة بعد عمر طويل ان شاء الله
تحياتي و تقييماتي
الرد
تم الشكر بواسطة: asemshahen5


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  [تم الحل] اضافة صورة لقاعدة البيانات اكسس anes 2 116 12-06-21, 02:16 AM
آخر رد: anes
  EmpDataGridView طباعة أعمدة معينة رامى محمد 0 72 01-06-21, 05:30 PM
آخر رد: رامى محمد
Lightbulb ارجوا المساعدة في طباعة الكاشير بدون إظهار التقرير abo.alaa315 6 392 02-05-21, 05:56 PM
آخر رد: alfaiz678
  [سؤال] استفسار عن تحويل كود طباعة داتا قريد فيو من اليسار لليمين Marwan9990 13 4,446 12-03-21, 07:22 PM
آخر رد: abuyazan
  كيفية إضافة لوجو الي كريستال ريبورت Lathe1 2 348 02-03-21, 01:24 AM
آخر رد: Lathe1
  ما سبب هذا الخطأ وكيف يتم الحل؟ أبو عبدالله الحلواني 6 560 28-01-21, 08:12 AM
آخر رد: ZaerAllail
  المساعدة - بكود زر البحث وخانة رقم التسجيل crazykinko 0 258 18-01-21, 04:52 PM
آخر رد: crazykinko
  قمت بعمل مثال لإستخراج النصوص من الصورة واجهتني مشكلة اللغة العربية ماهو الحل mohamedgadain61 1 397 17-01-21, 07:54 AM
آخر رد: ابراهيم ايبو
  [تم الحل]العمليات الحسابية في الداتا جريد فيو essawq 15 1,192 14-01-21, 12:34 AM
آخر رد: essawq
  [ تمّ الحل ] : الطباعة من خلال الريبورت فيور عبد العزيز البسكري 2 443 16-12-20, 04:03 AM
آخر رد: عبد العزيز البسكري

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


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم