تقرير من استعلام محوري

[aecc]

الاخوة الافاضل تحية طيبة ومبروك لعودة المنتدى والعود احمد

ارجو افادتي بخصوص تقرير مبني على استعلام جدولي محوري والمشكلة هي ان عناوين الصفوف والاعمدة تكون متغيرة كما نعرف في الاسعلامات الجدولية وبالتالي عند حذف البيانات المتعلقة بصف او عمود اوالاضافة عليها يجب بالتالي ان تختفي او تضاف في التقرير وهذا لا يحدث في الاعمدة

_________________.rar

[aecc]

يا اخوان ارجو سرعة الرد

[aecc]

الفزعة يا اخوان

[aecc]

يا اخوان اذا كان الموضوع غير مفهوم فهل يمكن لاحد الخبراء شرح الكود في قاعدة البيانات الاتية , ففيها الحل للسؤال ولا افهمها

CrossTab_Query.rar

[منذر عساج]

أخي الكريم

إليك خطوات الحل لهذه المشكلة:

1)قم بإنشاء إستعلام تحديد وليكن QFiled يستند الى الإستعلام الجدولي Crosstab .

2) قم بتغير مسميات الحقول في إستعلام التحديدQFiled الذي أنشأته الى العناوين من Field0 الى Field11 على الترتيب.

3)قم بإنشاء تقرير يستند الى إستعلام التحديدQFiled

4)قم بنسخ الكودين التاليين ووضعهما في الوحدة النمطية للتقرير General :

Function FillLabel(LabelNumber As Integer) As String
FillLabel = Nz(ReportLabel(LabelNumber), "")
End Function

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("Crosstab")
indexx = 0
    For Each fld In qdf.Fields
        If fld.Type >= 1 And fld.Type <= 12 Or fld.Type = 14 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 12
            FieldList = FieldList & "null as Field" & I & ","
     Next I
     FieldList = Left(FieldList, Len(FieldList) - 1)

 strSQL = "Select " & FieldList & " From Crosstab"

    db.QueryDefs.Delete "QFiled"
    Set qdf = db.CreateQueryDef("QFiled", strSQL)

 'MsgBox 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

لاحظ أننا قمنا بإدراج أسم الاستعلام الجدولي وإستعلام التحديد في الكود . 5) ضع الكود التالي في حدث عند الفتح للتقرير :

Dim I As Integer
    For I = 0 To 10
        ReportLabel(I) = ""
    Next I
    Call CreateReportQuery

6)قم بإضاف مربعات نص في رأس التقرير ضع فيها الكود التالي :

=filllabel(0)

بعدد الحقول لديك اي من 0 الى 11 وإستبدلها بمربعات التسمية الخاصة بالعناوين

7)قم بتسجيل المكتبة الخاصة DAO 3.6 إذا لم تكن مسجلة لديك

ملاحظة : لا تنسى تعريف المتغير التالي في الوحدة النمطية:

Dim ReportLabel(11) As String

والله الموفق ,,,,

Crosstab.rar

تم تعديل سبتمبر 23, 2007 بواسطه منذر عساج

[aecc]

بارك الله فيك اخ منذر

[saeedmg]

هذا ماكنت ابحث عنه لحل مشكلتي

والله حاولت اطبقها على تقريري وماقدرت

حيث ان التخصصات في راس التقرير وهي تتغير تزيد وتنقص

فزعتكم بالمساعدة

saeed33.rar

تم تعديل أكتوبر 22, 2007 بواسطه saeedmg

[saeedmg]

تكفون يالربع وتكفى تهز الرجاجيل

انا عملي متوقف على هذا التقرير

الرجاء المساعدة