هدية نموذج لطباعة التقارير

تابع للسابق

في الدالة FillReportList قد تظهر رسالة خطأ عند السطر:

temp = doc.Properties!Description

أو السطرين

temp = doc.Properties!Description

ctlTarget.RowSource = ctlTarget.RowSource & temp & ";"

ومهمة هذه الأسطر عرض الوصف الذي يسجل للتقرير عند النقر عليه بزر الفأرة الأيمن واختيار خصائص ثم كتابة الوصف في مربع القائمة ، إذا لم تسجل وصف للتقارير فقم بوضع فاصلة علوية أمام كل منها لتحويلها إلى تعليق ، قد تستفيد من الوصف إذا جعلت عدد أعمدة مربع القائمة اثنين وجعلت الوصف في العمود الثاني .

نسيت أن أقول أجعل للقائمة حدث عند النقر المزدوج ليفتح التقرير في العرض acPreview وللزرين حدث عند النقر ليعملا .

فائدة :

الكود التالي يعمل نفس عمل الدالة ولكنه أبسط منه :

Private Sub كل_التقارير()

Dim obj As AccessObject, dbs As Object

Dim الكل As Variant

Set dbs = Application.CurrentProject

For Each obj In dbs.AllReports

If IsEmpty(الكل) Then

الكل = obj.Name

MsgBox obj.Name

Else

الكل = الكل & ";" & obj.Name

End If

Next obj

Me![lstReports].RowSource = الكل

End Sub

فائدة أخرى :

غير عبارة :

Set dbs = Application.CurrentProject ' للجداول والاستعلامات فقط

For Each obj In dbs.AllReports ' للجميع

بأحد العبارات التالية :

للجداول

Set dbs = Application. CurrentData

For Each obj In dbs.AllTables

للإستعلامات

Set dbs = Application. CurrentData

For Each obj In dbs.AllQueries

للنماذج

For Each obj In dbs.AllForms

لصفحات البيانات

For Each obj In dbs.AllDataAccessPages

للماكروات

For Each obj In dbs.AllMacros

للوحدات النمطية

For Each obj In dbs.AllModules

وللجميع تحياتي

(f) Up (f)

اقتباس

هذا الكود يقوم بإظهار قائمة بالتقارير في مربع قائمة ويجب إنشاء زري عرض و طباعة ليكتمل ويمكن استعماله في أي قاعدة بيانات :

أنشئ نموذج يحوي زري أمر الأول باسم cmdPrint والثاني باسم cmdPreview ومربع قائمة باسم lstReports .

ثم ضع الأسطر التالية في الوحدة النمطية الخاصة بالنموذج :

Option Compare Database

Option Explicit



Private Sub lstReports_DblClick(Cancel As Integer)

cmdPreview_Click

End Sub



Private Sub cmdPreview_Click()

OutputReport acPreview

End Sub



Private Sub cmdPrint_Click()

OutputReport acNormal

End Sub



Private Sub Form_Load()

Dim rc As Variant

rc = FillReportList(Me!lstReports)

End Sub



Private Sub OutputReport(intView As Integer)



On Error GoTo OutputReport_err



Select Case intView

Case acPreview

If IsNull(Me!lstReports) Then

MsgBox "Please select a report.", vbOKOnly, "Daraware Reports"

Else

DoCmd.OpenReport Me!lstReports, acPreview

End If



Case acNormal

If IsNull(Me!lstReports) Then

MsgBox "Please select a report.", vbOKOnly, "Daraware Reports"

Else

DoCmd.OpenReport Me!lstReports, acNormal

End If



Case Else

MsgBox "Invalid case statement"

GoTo OutputReport_exit



End Select



OutputReport_exit:

Exit Sub



OutputReport_err:

Select Case Err

Case 2501 'Cancel a docmd event

Resume Next

Case Else

MsgBox Err & Error

Resume Next

End Select



End Sub



Function FillReportList(ctlTarget As Control) As Integer



Dim db As DATABASE

Dim con As Container

Dim doc As Document

Dim intHasDescription As Integer

Dim temp As Variant



On Error GoTo FillReportList_err



Set db = CurrentDb



ctlTarget.RowSource = ""



For Each doc In db.Containers!Reports.Documents



If Mid$(doc.Name, 1, 4) <> "usys" Then



intHasDescription = True

temp = doc.Properties!Description



If intHasDescription Then

temp = doc.Name

ctlTarget.RowSource = ctlTarget.RowSource & temp & ";"



temp = doc.Properties!Description

ctlTarget.RowSource = ctlTarget.RowSource & temp & ";"



End If



End If



Next doc





FillReportList_exit:

Exit Function



FillReportList_err:

Select Case Err

Case 3270

intHasDescription = False

Resume Next

Case Else

MsgBox Error

GoTo FillReportList_exit

End Select

End Function

يتبع

:

الكود التالي يعمل نفس عمل الدالة ولكنه أبسط منه :

Private Sub كل_التقارير()

Dim obj As AccessObject, dbs As Object

Dim الكل As Variant



Set dbs = Application.CurrentProject

For Each obj In dbs.AllReports

If IsEmpty(الكل) Then

الكل = obj.Name

MsgBox obj.Name

Else

الكل = الكل & ";" & obj.Name

End If

Next obj

Me![lstReports].RowSource = الكل



End Sub

فائدة أخرى :

غير عبارة :

Set dbs = Application.CurrentProject ' للجداول والاستعلامات فقط

For Each obj In dbs.AllReports ' للجميع

بأحد العبارات التالية :

للجداول

Set dbs = Application. CurrentData

For Each obj In dbs.AllTables

للإستعلامات

Set dbs = Application. CurrentData

For Each obj In dbs.AllQueries

(f)(f)شكراً ابو حمود (f)(f)

بارك الله في هذه الاصابع التي سطرت هذه الاكواد وجزاكم الله الف خير على هذا العمل