وعليكم السلام
انسخ هذا السبروتين لديك ..عند تشغيل التقرير كل مرة يأخذ قيمه من الاستعلام الجدولي
قم بتسمية حقول التقرير بأسماء مثل Field1,Field2 الخ ...لان اسم الحقل في الكود هو Field واجعلها مثلا سبعة حقول
Dim ReportLabel(7) As String
Sub CreateReportQuery()
On Error GoTo Err_CreateQuery
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim qdf As DAO.QueryDef
Dim fld As DAO.Field
Dim indexx As Integer
Dim FieldList As String
Dim strSQL As String
Dim i As Integer
Set db = CurrentDb
Set qdf = db.QueryDefs("qryReductionByPhysician_Crosstab")
indexx = 0
For Each fld In qdf.Fields
If fld.Type >= 1 And fld.Type <= 8 Or fld.Type = 10 Then
FieldList = FieldList & "[" & fld.Name & "] as Field" & indexx & ", "
ReportLabel(indexx) = fld.Name
End If
' MsgBox Label(indexx)
indexx = indexx + 1
Next fld
For i = indexx To 7
FieldList = FieldList & "null as Field" & i & ","
Next i
FieldList = Left(FieldList, Len(FieldList) - 1)
strSQL = "Select " & FieldList & " From qryReductionByPhysician_Crosstab"
db.QueryDefs.Delete "qryCrossTabReport"
Set qdf = db.CreateQueryDef("qryCrossTabReport", strSQL)
Exit_CreateQuery:
Exit Sub
Err_CreateQuery:
If Err.Number = 3265 Then '*** if the error is the query is missing
Resume Next '*** then skip the delete line and resume on the next line
Else
MsgBox Err.Description '*** write out the error and exit the sub
Resume Exit_CreateQuery
End If
End Sub
ثم قم بأستدعائه من حدث عند فتح التقرير وضع الكود التالي
Dim i As Integer
For i = 0 To 7
ReportLabel(i) = ""
Next i
Call CreateReportQuery
في راس التقرير قم بوضع مربعات نص ..مثلا سبعة كعدد الحقول واجعل مصدر السجلات
=filllabel(0) ,=filllabel(1) وهكذا
ثم انسخ الكود التالي
Function FillLabel(LabelNumber As Integer) As String
FillLabel = Nz(ReportLabel(LabelNumber), "")
End Function
بالتوفيق ان شاء الله