Foksh

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

وإياكم أخي الكريم .. .

انا ما عملتش حاجة .. انا بسألك حضرتك

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

وعليكم السلام ورحمة الله وبركاته.. سؤال واحد محيرني 😇 !!! تعبئة تلقائية سيكون لها مصدر ، اللي هو إييييه ؟؟؟؟؟؟؟؟؟؟؟؟؟؟

تفضل أخي الكريم .. baseM.zip

في الحقيقة ، كانت من بين الأمور التي بحاجة لتعديلات ، و وجهة نظرك سليمة 100% أستاذنا الفاضل .. مبدعون في تخصصكم ، وما أنا إلا بمبتدئ في مجال الكسل أخي عبدالله ، ولكني وجدت أن المسار بين آكسيس وأكسل متشابه الى حد ما ، ما دفعني الى الخوض في تجربة التعرف على اكسل بشكل أعمق ( تعميق علاقة بيني وبينه 😂 ) .

تمام أخي الكريم ،، نستطيع تلافي المشكلة بإخفاء النموذج بشكل مؤقت أثناء المعاينة !! استخدم الكود التالي في زر المعاينة ، وجرب Private Sub btnPrint_Click() If lstResults.ListCount = 0 Then MsgBox "لا توجد نتائج لطباعتها", vbExclamation: Exit Sub End If Dim sh As Worksheet, nextRow As Long, i As Long, j As Long Const REPORT_SHEET As String = "تقرير الغياب" Me.Hide On Error Resume Next: Application.DisplayAlerts = False Worksheets(REPORT_SHEET).Delete Application.DisplayAlerts = True: On Error GoTo 0 Set sh = Worksheets.Add(After:=Worksheets(Worksheets.Count)) sh.Name = REPORT_SHEET For j = 0 To lstResults.ColumnCount - 1 sh.Cells(1, j + 1).Value = "العمود " & j + 1 Next j sh.Range("A1:" & sh.Cells(1, lstResults.ColumnCount).Address).Font.Bold = True nextRow = 2 For i = 0 To lstResults.ListCount - 1 For j = 0 To lstResults.ColumnCount - 1 sh.Cells(nextRow, j + 1).Value = lstResults.List(i, j) Next j nextRow = nextRow + 1 Next i sh.Columns.AutoFit sh.PageSetup.Orientation = xlPortrait sh.PageSetup.Zoom = False sh.PageSetup.FitToPagesWide = 1 sh.PageSetup.FitToPagesTall = 1 sh.PrintPreview Me.Show End Sub

رغم أن معظم الأكواد تحتاج الى إعادة هيكلة وتصحيح ، ولكن جرب هذا المقترح ، بعد ما تمت تجربته على ملفك السابق :- Private Function GetDateColumn(ByVal searchDate As Date) As Long Dim cell As Range Dim searchRange As Range Set searchRange = wsData.Range(wsData.Cells(HEADER_ROW, DATE_COL_START), _ wsData.Cells(HEADER_ROW, wsData.Columns.Count)) For Each cell In searchRange If IsDate(cell.Value) Then If CDate(cell.Value) = searchDate Then GetDateColumn = cell.Column Exit Function End If End If Next cell GetDateColumn = 0 End Function جرب الملف التالي وشوف النتيجة Book5.zip

التحديث الجديد يستحق الإنتظار 🤗

وعليكم السلام ورحمة الله وبركاته .. اخي الكريم ، الدالة GetDateColumn غير موجودة في الأكواد ، وهذا سبب الرسالة .

وعليكم السلام ورحمة الله وبركاته ، أخي الكريم ، بدايةً أهلاً وسهلاً بك معنا في منتديات أوفيسنا - آكسيس .. ونرجو أن تجد جميع الحلول للمشاكل التي قد تواجهك . واسمح لي بتذكيرك بضرورة :- أولاً :- إرفاق ملف بسيط للأجزاء المتعلقة بالمشكلة . ثانياً :- الإفصاح والتوضيح والشرح الكافي الوافي للمشكلة - لاحقاً . ثالثاً :- الإهتمام بالعنوان ليكون دالاً بإيجاز عن المشكلة . رابعاً :- استخدم الزر المشار اليه بالمربع الأحمر الموجود في المكان الذي تكتب فيه الموضوع عندما تريد أن تكتب أكواد VBA على سبيل المثال في مواضيعك أو ردودك . شكراً لسعة صدرك

أخي الكريم ، على حسب ما فهمت من كلامك ، انظر التعديلات التالية :- المديول :- Public Function GetTxtHeight(annee As String, grade As String, wilaya As String, ByRef rapport As String) As Single Dim db As DAO.Database Dim rs As DAO.Recordset Dim hauteur As Single Set db = CurrentDb Set rs = db.OpenRecordset( _ "SELECT hauteur_rang, nom_raport FROM tab_hauteur_range " & _ "WHERE annee = '" & Replace(Trim(annee), "'", "''") & "' " & _ "AND grade = '" & Replace(Trim(grade), "'", "''") & "' " & _ "AND wilaya = '" & Replace(Trim(wilaya), "'", "''") & "'", dbOpenSnapshot) If Not rs.EOF Then hauteur = Nz(rs!hauteur_rang, 0) * 567 rapport = Nz(rs!nom_raport, "") Else hauteur = 0.7 * 567 rapport = "" End If rs.Close: Set rs = Nothing: Set db = Nothing GetTxtHeight = hauteur End Function حدث الزر :- Private Sub أمر2_Click() Dim h As Single Dim rapport As String h = GetTxtHeight(Me.annet, Me.grade1, Me.wilaya1, rapport) TempVars!Temp_Hauteur = h If rapport <> "" Then DoCmd.OpenReport rapport, acViewPreview Else MsgBox ". لم يتم العثور على تقرير مطابق", vbInformation + vbMsgBoxRight, "" End If End Sub حدث فتح التقرير :- Private Sub Report_Open(Cancel As Integer) Dim h As Single Dim ctrl As Control h = Nz(TempVars!Temp_Hauteur, 0.7 * 567) For Each ctrl In Me.Controls If ctrl.ControlType = acTextBox Then If LCase(Trim(Nz(ctrl.Tag, ""))) = "moho58" Then ctrl.Height = h End If End If Next ctrl End Sub لاحظ اننا اعتمدنا على Tag = moho58 لمربعات النص التي نريد التنفيذ عليها ، دون الحاجة الى تحديد الأسماء بشكل يدوي .. الملف :- baseM.zip

مهندسنا الغالي ،، رضي الله عنكم ، و وفقكم لما فيه خير .. أشكرك على المرور العطر .

ارفق ملف يحتوي أكثر من شرط أخي الكريم ، مع العلم ان ارتفاع جزء التفاصيل سيكون حسب ارتفاع المربعات النصية !!!!!!

شكراً لك مرورك أخي الكريم .. انتظر التحديث الجديد

وعليكم السلام ورحمة الله وبركاته ,, كفكرة بسيطة ، في مديول جديد ، استعمل الدالة التالية :- Public Function GetTxtHeight(annee As String, grade As String, wilaya As String, nomRapport As String) As Single Dim db As DAO.Database Dim rs As DAO.Recordset Dim hauteur As Single Set db = CurrentDb Set rs = db.OpenRecordset( _ "SELECT hauteur_rang FROM tab_hauteur_range " & _ "WHERE annee = '" & annee & "' " & _ "AND grade = '" & grade & "' " & _ "AND wilaya = '" & wilaya & "' " & _ "AND nom_raport = '" & nomRapport & "'", dbOpenSnapshot) If Not rs.EOF Then hauteur = rs!hauteur_rang * 567 Else hauteur = 0.7 * 567 End If rs.Close: Set rs = Nothing: Set db = Nothing GetTxtHeight = hauteur End Function ثم في حدث الزر عند التقر لفتح التقرير :- Private Sub أمر2_Click() Dim h As Single Dim annee As String, grade As String, wilaya As String, rapport As String rapport = "rap_pv" annee = Me.annee grade = Me.grade1 wilaya = Me.wilaya1 h = GetTxtHeight(annee, grade, wilaya, rapport) TempVars!Temp_Hauteur = h DoCmd.OpenReport rapport, acViewPreview End Sub وفي حدث عند الفتح للتقرير :- Private Sub Report_Open(Cancel As Integer) Dim h As Single If Not IsNull(TempVars!Temp_Hauteur) Then h = TempVars!Temp_Hauteur Else h = 0.7 * 567 End If Me.nom.Height = h Me.prenom.Height = h End Sub مع ضرورة عدم تمكين لمربعي النص ( nom و prenom ) مع العلم ان الفكرة قابلة للتطوير بالتحكم بحجم الخط أيضاً 😉 الملف :- baseM.zip

وعليكم السلام ورحمة الله وبركاته.. مشاركتكم الأفكار ، بأن تكون الدالة معتمدة على الـ Tag بالإضافة الى الجدول ( أو بدونه بتضمين اللون في الاستدعاء ) ، بحيث كل مجموعة عناصر مشتركة في Tag واحد تأخذ نفس اللون بغض النظر عن موقعها !! 💡 مجرد فكرة ، ولكني نفذت مشابهاً لها في تغيير لون خلفية وخط عناصر من نوع ليبل حسب شرط محدد في مشروع لإدارة تأجير الشقق الفندقية والعقارات ،،

بارك الله بكم استاذي الفاضل 😇.. شكراً لك 💐

ماذا لو حصل خلل أو انقطاع الكهرباء أو تلف ... الخ !!!! رغم أنك وأعتقد ذلك من خلال المكتبات أنك أسست للربط بجهاز البصمة ، فهل الخلل الحاصل سيتحمله الموظف ويدخل في متاهة أثبت أو إحلف 😅 ..... الخ. ما لم تكن هناك حلول لهذه الإحتمالات قد تم أخذها في الحسبان ، فرأيي أن الأنظمة التي يقود مركبها جهاز قابل للخطأ = غير عادلة. أشعر انني انفعلت قليلاً 🤣😂 هي وجهة نظر ما لم يكن معلمي قد خبأ لنا إجابة تنتظر هذا التعليق . الأكواد جميلة جدا ، وفكرتها جميلة وقد ألمت بجميع النواحي البرمجية التي تحدثتم عنها سابقاً.

الحمد لله على نعمه.. لا تنسى إغلاق الموضوع أخي الكريم 🤗

حبيبي يا هندسة 🤗 اللهم تقبل دعائكم بظهر الغيب 🤲🏻 شكراً لمرورك اختنا الكريمة ،، ولكم من الدعاء النصيب الأكبر 😇

وإياكم أخي الكريم .. شكراً لمرورك العطر

كثيرون استفسروا عن كيفية اختيار اسم مخزن في الجدول ، بدلاً من كتابة الرقم بشكل يدوي . ولذا قد صورت هذا الفيديو كفكرة سريعة على الخطوات - وصولاً إلى النتيجة ,, طبعاً كلمة كثيرون = في مجموعة الواتس أب الخاصة بقسم آكسيس وليس في المنتدى 🤣

وعليكم السلام ورحمة الله وبركاته ،، وبما اني اتابع من الجوال ، ولم استطع من رؤية الملف . اعتقد ان هناك أكثر من فكرة !!! الأولى قد تعتمد على دالة تتفقد جميع العناصر ذات النوع "مربع نص" بأنها تحتوي قيم وغير فارغة . وهذا قد يسبب مشكلة لأنه حينها لن يميز بين مربعات النص التي تريدها من مربعات نص أخرى على سبيل المثال . الثانية أنه عند الحفظ وقبل إتمام عملية الحفظ التأكد من مربعات النص التي لها مصدر بيانات مرتبط بحقل وليس مربعات النص الغير مضمنة بمصدر بيانات ، وهنا قد تكون مشكلة أيضاً . الثالثة وما أرجحها بشكل أفضل وأقوى ، وهو من خلال الـ TAG . بحيث تضع وسماً لجميع مربعات النص التي تريدها أن يتم التحقق منها ولنفترض = Ham حيث من خلال زر الحفظ نستعمل كود بهذا الشكل تقريباً - ما لم أكن مخطئاً في بعض الأجزاء .. dim ctl as control, missing as string for each ctl in me.controls if lcase(trim(ctl.tag)) = "Ham" then if nz(ctl.value, "") = "" then missing = missing & vbcrlf & ctl.name end if end if next if missing <> "" then msgbox " : الحقول التالية فارغة" & vbcrlf & missing, vbinformation+ vbmsgboxright, "" exit sub end if docmd.runcommand accmdsaverecord docmd.gotorecord,,acnewrec طبعاً ، إذا كنت من الأشخاص الذين يتركون اسم مربع النص كما هو من مصدره من الجدول ، فقد قمت بإضافة فكرة تحديد اسماء المربعات النصية التي لم يتم ادخال بيانات فيها . بكل الأحوال جرب وأخبرنا بالنتيجة ، عل أحد الأساتذة والأخوة يتابع معك من كمبيوتر 🥴 على كل حال جرب خطر على بالي نقطة أخرى من خلال السطر :- missing = missing & vbcrlf & ctl.name بأن نستبدله بالسطر التالي :- missing = missing & vbcrlf & ctl.controls(0).caption فهنا سيأقرأ التسمية ( label ) المرتبطة بكل مربع نص بدلاً من اسم مربع النص نفسه .