محمد أبوعبدالله

ممكن شرح اكثر اخي الكريم وهل بدأت في تنفيذ الفكرة ام لا ؟ تحياتي

اين الصورة ؟

الحقيقة الكود روعة جدا ويعمل بكفاءة جرب المرفق وارجو ان يكون طلبك Shrik-to-fit-or-AutoResizeFont.rar تحياتي

اضف الى الاستعلام N1: Nz([عدد الموظفين])/Nz([عدد المسجلين]) المستخدم_3.rar تحياتي

انظر الاستعلام Query1 المستخدم_3.rar تحياتي

بالتوفيق اخي الكريم تحياتي

هذا موضوع اخر اخي بلال اتفضل اخي المستخدم_3.rar تحياتي

وعليكم السلام ورحمة الله وبركاته اين المثال يا غالي تحياتي

وجزاكم الله خيرا بالتوفيق اخي الكريم تحياتي

السلام عليكم ورحمة الله وبركاته مرحبا اخي الكريم الكود الجديد الآن يمكن التحكم بناتج البحث متاطبق وغير متاطابق (جزء من الاسم ) وذلك عن طريق المتغير chk ويمكن التحكم بقيمة المتغير كالتالي chk = 0 غير متطابق chk = 1 متطابق والان كود البحث كالتالي On Error Resume Next Dim mySqL As String Dim mySQLWhere As String Dim mySqLAnd As String Dim chk As Integer ' ÛíÑ ãÊØÇÈÞ ' chk = 0 ' ãÊÇØÇÈÞ chk = 1 mySqLAnd = " AND " mySqL = "SELECT * FROM tblSearch " If Len(Me.X1 & vbNullString) Then If (chk) Then mySQLWhere = "[X1] Like " & Chr$(39) & "*" & Me.X1 & "*" & Chr$(39) Else mySQLWhere = "[X1] = " & Chr$(39) & Me.X1 & Chr$(39) End If mySQLWhere = mySQLWhere & mySqLAnd End If If Len(Me.X2 & vbNullString) Then If (chk) Then mySQLWhere = "[X2] Like " & Chr$(39) & "*" & Me.X2 & "*" & Chr$(39) Else mySQLWhere = "[X2] = " & Chr$(39) & Me.X2 & Chr$(39) End If mySQLWhere = mySQLWhere & mySqLAnd End If If Len(Me.X3 & vbNullString) Then If (chk) Then mySQLWhere = "[X3] Like " & Chr$(39) & "*" & Me.X3 & "*" & Chr$(39) Else mySQLWhere = "[X3] = " & Chr$(39) & Me.X3 & Chr$(39) End If mySQLWhere = mySQLWhere & mySqLAnd End If If Len(Me.X4 & vbNullString) Then If (chk) Then mySQLWhere = "[X4] Like " & Chr$(39) & "*" & Me.X4 & "*" & Chr$(39) Else mySQLWhere = "[X4] = " & Chr$(39) & Me.X4 & Chr$(39) End If mySQLWhere = mySQLWhere & mySqLAnd End If If Len(Me.X5 & vbNullString) Then If (chk) Then mySQLWhere = "[X5] Like " & Chr$(39) & "*" & Me.X5 & "*" & Chr$(39) Else mySQLWhere = "[X5] = " & Chr$(39) & Me.X5 & Chr$(39) End If mySQLWhere = mySQLWhere & mySqLAnd End If If Len(Me.X6 & vbNullString) Then If (chk) Then mySQLWhere = "[X6] Like " & Chr$(39) & "*" & Me.X6 & "*" & Chr$(39) Else mySQLWhere = "[X6] = " & Chr$(39) & Me.X6 & Chr$(39) End If mySQLWhere = mySQLWhere & mySqLAnd End If If Len(Me.X7 & vbNullString) Then If (chk) Then mySQLWhere = "[X7] Like " & Chr$(39) & "*" & Me.X7 & "*" & Chr$(39) Else mySQLWhere = "[X7] = " & Chr$(39) & Me.X7 & Chr$(39) End If mySQLWhere = mySQLWhere & mySqLAnd End If If Len(Me.X8 & vbNullString) Then If (chk) Then mySQLWhere = "[X8] Like " & Chr$(39) & "*" & Me.X8 & "*" & Chr$(39) Else mySQLWhere = "[X8] = " & Chr$(39) & Me.X8 & Chr$(39) End If mySQLWhere = mySQLWhere & mySqLAnd End If If Len(Me.X9 & vbNullString) Then If (chk) Then mySQLWhere = "[X9] Like " & Chr$(39) & "*" & Me.X9 & "*" & Chr$(39) Else mySQLWhere = "[X9] = " & Chr$(39) & Me.X9 & Chr$(39) End If mySQLWhere = mySQLWhere & mySqLAnd End If If Len(mySQLWhere) Then mySQLWhere = Left$(mySQLWhere, Len(mySQLWhere) - (Len(mySqLAnd) - 1)) End If Me.Search2.Form.Filter = mySQLWhere Me.Search2.Form.FilterOn = True وكود الطباعة كالتالي On Error Resume Next Dim stDocName As String Dim mySqL As String Dim mySQLWhere As String Dim mySqLAnd As String Dim chk As Integer ' ÛíÑ ãÊØÇÈÞ ' chk = 0 ' ãÊØÇÈÞ chk = 1 mySqLAnd = " AND " mySqL = "SELECT * FROM tblSearch " If Len(Me.X1 & vbNullString) Then If (chk) Then mySQLWhere = "[X1] Like " & Chr$(39) & "*" & Me.X1 & "*" & Chr$(39) Else mySQLWhere = "[X1] = " & Chr$(39) & Me.X1 & Chr$(39) End If mySQLWhere = mySQLWhere & mySqLAnd End If If Len(Me.X2 & vbNullString) Then If (chk) Then mySQLWhere = "[x2] Like " & Chr$(39) & "*" & Me.X2 & "*" & Chr$(39) Else mySQLWhere = "[x2] = " & Chr$(39) & Me.X2 & Chr$(39) End If mySQLWhere = mySQLWhere & mySqLAnd End If If Len(Me.X3 & vbNullString) Then If (chk) Then mySQLWhere = "[X3] Like " & Chr$(39) & "*" & Me.X3 & "*" & Chr$(39) Else mySQLWhere = "[X3] = " & Chr$(39) & Me.X3 & Chr$(39) End If mySQLWhere = mySQLWhere & mySqLAnd End If If Len(Me.X4 & vbNullString) Then If (chk) Then mySQLWhere = "[X4] Like " & Chr$(39) & "*" & Me.X4 & "*" & Chr$(39) Else mySQLWhere = "[X4] = " & Chr$(39) & Me.X4 & Chr$(39) End If mySQLWhere = mySQLWhere & mySqLAnd End If If Len(Me.X5 & vbNullString) Then If (chk) Then mySQLWhere = "[X5] Like " & Chr$(39) & "*" & Me.X5 & "*" & Chr$(39) Else mySQLWhere = "[X5] = " & Chr$(39) & Me.X5 & Chr$(39) End If mySQLWhere = mySQLWhere & mySqLAnd End If If Len(Me.X6 & vbNullString) Then If (chk) Then mySQLWhere = "[X6] Like " & Chr$(39) & "*" & Me.X6 & "*" & Chr$(39) Else mySQLWhere = "[X6] = " & Chr$(39) & Me.X6 & Chr$(39) End If mySQLWhere = mySQLWhere & mySqLAnd End If If Len(Me.X7 & vbNullString) Then If (chk) Then mySQLWhere = "[X7] Like " & Chr$(39) & "*" & Me.X7 & "*" & Chr$(39) Else mySQLWhere = "[X7] = " & Chr$(39) & Me.X7 & Chr$(39) End If mySQLWhere = mySQLWhere & mySqLAnd End If If Len(Me.X8 & vbNullString) Then If (chk) Then mySQLWhere = "[X8] Like " & Chr$(39) & "*" & Me.X8 & "*" & Chr$(39) Else mySQLWhere = "[X8] = " & Chr$(39) & Me.X8 & Chr$(39) End If mySQLWhere = mySQLWhere & mySqLAnd End If If Len(Me.X9 & vbNullString) Then If (chk) Then mySQLWhere = "[X9] Like " & Chr$(39) & "*" & Me.X9 & "*" & Chr$(39) Else mySQLWhere = "[X9] = " & Chr$(39) & Me.X9 & Chr$(39) End If mySQLWhere = mySQLWhere & mySqLAnd End If If Len(mySQLWhere) Then mySQLWhere = Left$(mySQLWhere, Len(mySQLWhere) - (Len(mySqLAnd) - 1)) End If Debug.Print mySQLWhere Me.Visible = False stDocName = "rep1" DoCmd.OpenReport stDocName, acPreview, , mySQLWhere 003.zip تحياتي

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

يمكن ان شاء الله ولكن ارى الطريقة الاولى اصح من هذه حسابياً TEST_SUM_SECTOR.rar تحياتي

يمكنك استخدام نفس الكود واستبدال السطرينن الاخيرين فقط بـ stDocName = "rep1" DoCmd.OpenReport stDocName, acPreview, , strSQLWhere واستبدال السطرينن الاخيرين في الكود الاخير بـ stDocName = "rep1" DoCmd.OpenReport stDocName, acPreview, , myCriteria تحياتي

بالتوفيق اخي الكريم تحياتي

نعم الكود الثاني On Error GoTo Err_أمر39_Click If t2.SourceObject = "" Then MsgBox "غفواً.. لايمكن فتح تقرير قبل فتح النموذج" Exit Sub End If Dim stLinkCriteria As String stLinkCriteria = "[الموسم الدراسي]='" & [نص30] & "' And [القسم]='" & [نص32] & "' And [رقم الفوج]='" & [مربع_تحرير_وسرد35] & "'" Dim stDocName As String stDocName = ChrW(1578) & ChrW(1602) & ChrW(1585) & ChrW(1610) & ChrW(1585) & ChrW(49) DoCmd.OpenReport stDocName, acViewReport, , stLinkCriteria DoCmd.OutputTo acOutputReport, "تقرير1", acFormatXLS, CurrentProject.Path & "\" & stDocName & ".xls", True Exit_أمر39_Click: Exit Sub Err_أمر39_Click: MsgBox Err.Description Resume Exit_أمر39_Click