نجوم المشاركات

وعليكم السلا.. طيب هو رقم الاصدار واحد ولا ايه ...على العموم ..استخدم هذه الدالة حسب الجدول لديك في حدث عند التحميل للنموذج ..طبعا جعلت المعرف=1 لاني مش عارف حاجة 100% Me.Caption = DLookup("[رقم الاصدار]", "[جدول الاصدار]", "[ID]=1")

الطريقة الاولى بمصدر السجلات If IsNull(Me.Text0) Then GoTo k Else GoTo a End If a: Dim rs As DAO.Recordset Set rs = CurrentDb.OpenRecordset("SELECT items.* FROM items;") rs.FindFirst "[barcod] =" & Me.Text0 If Not rs.NoMatch Then MsgBox "الرقم مسجل" Else MsgBox "رقم غير مسجل" End If rs.Close Set rs = Nothing Exit Sub k: MsgBox "اكتب رقم الباركود" الثانية عد السجلات بواسطة دالة DCount Dim x As Integer x = DCount("[barcod]", "items", "[barcod]=" & Me.Text0) If x > 0 Then MsgBox "الرقم مسجل" Else MsgBox "رقم غير مسجل" End If مرفق الملف رسالة بعدم وجوده فى جدول اخر(1).accdb

The question is not clear but this is a code that randomize the data Sub Test() Dim a a = GetRandomRows(Range("A1").CurrentRegion) Range("H1").Resize(UBound(a, 1), UBound(a, 2)).Value = a End Sub Function GetRandomRows(ByVal rng As Range) Dim outputArray(), shuffledRows(), allRows(), selectedRows As Object, numRows As Long, numCols As Long, i As Long, j As Long numRows = rng.Rows.Count numCols = rng.Columns.Count ReDim outputArray(1 To numRows, 1 To numCols) Set selectedRows = CreateObject("Scripting.Dictionary") allRows = Application.Transpose(Evaluate("Row(" & rng.Rows(1).Address & ":" & rng.Rows(numRows).Address & ")")) shuffledRows = ShuffleArray(allRows) For i = 1 To numRows If Not selectedRows.Exists(shuffledRows(i)) Then selectedRows.Add shuffledRows(i), True For j = 1 To numCols outputArray(i, j) = rng(shuffledRows(i) - rng.Row + 1, j) Next j End If Next i GetRandomRows = outputArray End Function Function ShuffleArray(ByVal arr) Dim temp, i As Long, j As Long Randomize For i = UBound(arr) To LBound(arr) + 1 Step -1 j = Int((i - LBound(arr) + 1) * Rnd + LBound(arr)) temp = arr(j) arr(j) = arr(i) arr(i) = temp Next i ShuffleArray = arr End Function

الاطروحات السابقة تناولت فيها العديد من الافكار حول الاستفادة من الفورم التفاعلي وعناصر التحكم وصفات كل عنصر علي حدة احيانا المستخدم يكون محتاج شاشة كبيرة فيها العديد والعديد من عناصر التحكم مما يشكل حالة من عدم التركيز للشكل العام وكمية العناصر المعروضة في الوقت نفسه فكرة بسيطة تخلي الفورم نفسه يعرض لك يلي انت محتاجه وذلك عن طريق التحكم في خصائص عنصر التحكم نفسه الفكرة باختصار كانك شغال علي دوت نت او علي اي موقع تضغط علي تبويب معين يظهر لك عناصر التحكم الخاصة به وتتحكم فيه كما تشاء اسيبكم للتجربة وان شاء الله تكون فيها النفع ولا تنسونا بدعوة بظهر الغيب بصلاح الحال المثال المرفق علي بيانات الموظفين لا يحتوي الا علي اكواد الحركة الخاصة بالموضوع Create Drill Down Data Entry.xlsm

فعلا اذا حظر الماء يبطل التيمم مثلما يقولون..احسنت استاذ @ابوخليل كنت افكر بعمل جدول للاوزان حسب العمر واعمل موديول يفر على السجلات ويعمل مقارنة لكن للاسف لم استطع كتابة الجدول ..لان كل وزن يجب كتابته حسب العمر والطول مرفق ملف لمن اراد الفائدة W.rar

I suppose you are looping through cells in a range so in VBE insert new module then type the code like that Sub Test() Dim cel As Range For Each cel In Range("D1:D10").Cells cel.Value = Replace(cel.Value, "/", "-") Next cel End Sub

اذا كان المطوب البحث بالفاصلة العشرية .. فتم التعديل البحث فى كل اوراق العمل.xlsb بحث بشرطين kml2.xlsm

You can simply use Replace Function Debug.Print Replace(cell.Value,"/","-")

عليكم السلام لا داعي لكود يمكن عمل ذلك من Custom << Format cells << وهناك يمكنك الاستبدال

السلام عليكم ورحمة الله وبركاته هذا الشيت من اعمال الاستاذ وجيه شرف الدين التى ساعدنى بها زر ينبثق منه ازرار.xlsm

برنامج يصلح لادارة عيادات الاسنان والعلاج الطبعى بسيط وسهل الاستخدام بدون باسورد طبيب الاسنان او العلاج الطبيعى.xlsm

DoCmd.CopyObject , Me.comboform, acForm, "No deletion" حلوة .. سلمت اناملك .. @TQTHAMI ننتظر المزيد

بالتوفيق يارب ...ودعواكم لنا يا أهل المملكة المشرفة

كثر الله خيرك استاذي الغالي اذا لم نجد طريقه من احد الاخوه ما معانا الا كودك تحياتي اليك مشكورررررررررر

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

وعليكم السلام .. اعتقد ...تحتاج مع كل حقل تعمل هذا ..انا عملته مع حقل واحد ..اعمله مع التسعة البقية ويجب اضافة هذا الحقل ايضا ID_Time الى النموذج واجعله مخفي Private Sub day1_AfterUpdate() DoCmd.SetWarnings False DoCmd.RunSQL "UPDATE table_BAIN SET day1 = " & Me.day1 & " WHERE ID_Time = " & Me.ID_Time DoCmd.SetWarnings True Me.Requery End Sub

@ابوخليل @Eng.Qassim شكر وتقدير اشكركم اساتذتي الاستاذ ابو خليل والمهندس قاسم في مساعدتي في حل مشكلتي الله يحفظكم ويوفقكم وان شاء الله في اعلى المراتب والمناصب كذلك اشكر الاخوة @TQTHAMI ,والاخ @AbuuAhmed في مساعدتي الله يحفظكم ويوفكم ان شاء الله

فيك البركة يا غالي..فكرة جميلة جدا ..عاشت الايادي

في مربع البحث ضع هذا الكود ..اعتما على علامة الصح والرقم الوظيفي ستظهر رسالة تنبيه ويمكن استخدام دالة dlookup ايضا Dim cardN As Long cardN = Val(Me.txtSearch.Value) If cardN > 0 Then Dim rs As Recordset Set rs = CurrentDb.OpenRecordset("SELECT * FROM Customers WHERE cardN=" & cardN & " AND ISaCTIVE=True;") If Not rs.EOF Then MsgBox "الموظف مستقيل" End If rs.Close End If

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

شكرا لثنائك مهندس قاسم .. بارك الله فيك وكتب اجرك مثلك تماما في البداية جاء على بالي الجدول ولكني نظرت فإذا القيم ثابتة لا يمكن ان تتبدل . لذا افضل مكان لها هو الكود الاعمال التي يحتمل ان يجري عليها التعديل مثل .. جداول الحصص المدرسية او سلم الرواتب والمكافآت ... وامثالها .. فهذه يجب ن يكون مكانها الجدول

😀Thank u for your support and interest

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

في المشاركه الاولي للأستاذ @محمد حسن المحمد https://www.officena.net/ib/topic/118435-qrcode/?do=findComment&comment=714178

تفضل هذه الوحدة النمطية الخاصة كما في الصورة اعلاه افتح الاستعلام وانظر النتيجة : الرقم الموجب زيادة والرقم السالب نقص والصفر هو الوزن المثالي يمكنك بناء نموذجك على الاستعلام ولا حظ ان اي تغيير على الارقام سيتغير التقييم آليا يمكن ايضا ادخال الجنس ذكر / انثى ضمن الوحدة النمطية ان رغبت في ذلك سوف اضع لك الاساس وانت تدخل الاوزان Public Function GetPerfectWeight(xheight As Integer, xold As Integer) As Double If xheight = 150 Then If xold <= 24 Then GetPerfectWeight = 57 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 60 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 61 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 64 If xold >= 50 Then GetPerfectWeight = 67 End If If xheight = 152 Then If xold <= 24 Then GetPerfectWeight = 59 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 62 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 63 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 65 If xold >= 50 Then GetPerfectWeight = 68 End If If xheight = 154 Then If xold <= 24 Then GetPerfectWeight = 60 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 63 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 64 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 67 If xold >= 50 Then GetPerfectWeight = 70 End If If xheight = 156 Then If xold <= 24 Then GetPerfectWeight = 63 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 64 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 66 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 68 If xold >= 50 Then GetPerfectWeight = 72 End If If xheight = 158 Then If xold <= 24 Then GetPerfectWeight = 63 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 66 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 67 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 71 If xold >= 50 Then GetPerfectWeight = 73 End If If xheight = 160 Then If xold <= 24 Then GetPerfectWeight = 65 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 67 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 69 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 72 If xold >= 50 Then GetPerfectWeight = 75 End If If xheight = 162 Then If xold <= 24 Then GetPerfectWeight = 66 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 68 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 70 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 74 If xold >= 50 Then GetPerfectWeight = 76 End If If xheight = 164 Then If xold <= 24 Then GetPerfectWeight = 67 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 69 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 72 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 75 If xold >= 50 Then GetPerfectWeight = 77 End If If xheight = 166 Then If xold <= 24 Then GetPerfectWeight = 68 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 71 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 74 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 76 If xold >= 50 Then GetPerfectWeight = 79 End If If xheight = 168 Then If xold <= 24 Then GetPerfectWeight = 69 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 73 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 75 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 78 If xold >= 50 Then GetPerfectWeight = 80 End If If xheight = 170 Then If xold <= 24 Then GetPerfectWeight = 70 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 74 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 77 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 80 If xold >= 50 Then GetPerfectWeight = 83 End If If xheight = 172 Then If xold <= 24 Then GetPerfectWeight = 72 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 76 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 78 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 81 If xold >= 50 Then GetPerfectWeight = 85 End If If xheight = 174 Then If xold <= 24 Then GetPerfectWeight = 74 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 77 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 80 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 83 If xold >= 50 Then GetPerfectWeight = 86 End If If xheight = 176 Then If xold <= 24 Then GetPerfectWeight = 76 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 78 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 82 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 85 If xold >= 50 Then GetPerfectWeight = 88 End If If xheight = 178 Then If xold <= 24 Then GetPerfectWeight = 77 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 80 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 83 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 87 If xold >= 50 Then GetPerfectWeight = 90 End If If xheight = 180 Then If xold <= 24 Then GetPerfectWeight = 79 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 82 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 85 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 89 If xold >= 50 Then GetPerfectWeight = 92 End If If xheight = 182 Then If xold <= 24 Then GetPerfectWeight = 81 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 84 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 87 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 90 If xold >= 50 Then GetPerfectWeight = 94 End If If xheight = 184 Then If xold <= 24 Then GetPerfectWeight = 82 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 86 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 89 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 92 If xold >= 50 Then GetPerfectWeight = 96 End If If xheight = 186 Then If xold <= 24 Then GetPerfectWeight = 84 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 87 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 90 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 94 If xold >= 50 Then GetPerfectWeight = 98 End If If xheight = 188 Then If xold <= 24 Then GetPerfectWeight = 85 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 89 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 92 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 96 If xold >= 50 Then GetPerfectWeight = 100 End If If xheight = 190 Then If xold <= 24 Then GetPerfectWeight = 86 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 90 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 95 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 98 If xold >= 50 Then GetPerfectWeight = 102 End If If xheight = 192 Then If xold <= 24 Then GetPerfectWeight = 87 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 91 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 96 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 100 If xold >= 50 Then GetPerfectWeight = 104 End If If xheight = 194 Then If xold <= 24 Then GetPerfectWeight = 88 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 92 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 98 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 102 If xold >= 50 Then GetPerfectWeight = 106 End If If xheight = 196 Then If xold <= 24 Then GetPerfectWeight = 89 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 93 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 100 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 104 If xold >= 50 Then GetPerfectWeight = 108 End If If xheight = 198 Then If xold <= 24 Then GetPerfectWeight = 90 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 94 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 101 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 106 If xold >= 50 Then GetPerfectWeight = 110 End If If xheight = 200 Then If xold <= 24 Then GetPerfectWeight = 91 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 95 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 103 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 108 If xold >= 50 Then GetPerfectWeight = 112 End If End Function الوزن المثالي2.rar

يمكن اختصار .Add a(i, 1), Array(Array(a(i, 1), a(i, 2), a(i, 3), a(i, 4), a(i, 5), a(i, 6), _ a(i, 7), a(i, 8), a(i, 9), a(i, 10), a(i, 11), a(i, 12), a(i, 13), a(i, 14), a(i, 15), _ a(i, 16), a(i, 17), a(i, 18), a(i, 19), a(i, 20), a(i, 21), a(i, 22), a(i, 23), _ a(i, 24), a(i, 25), a(i, 26), a(i, 27)), Array(a(i, 28), a(i, 29))) إلى .Add a(i, 1), Array(Application.Transpose(Application.Index(a, i, Evaluate("row(1:" & UBound(a, 2) - 2 & ")"))), _ Array(a(i, UBound(a, 2) - 1), a(i, UBound(a, 2)))) Sub test() Dim a, aa, w Dim i& a = Sheets(1).Cells.CurrentRegion With CreateObject("scripting.dictionary") For i = 2 To UBound(a) If Not .exists(a(i, 1)) Then .Add a(i, 1), Array(Application.Transpose(Application.Index(a, i, Evaluate("row(1:" & UBound(a, 2) - 2 & ")"))), _ Array(a(i, UBound(a, 2) - 1), a(i, UBound(a, 2)))) Else w = .Item(a(i, 1)) w(1)(0) = w(1)(0) & "|" & a(i, UBound(a, 2) - 1) w(1)(1) = w(1)(1) & "|" & a(i, UBound(a, 2)) .Item(a(i, 1)) = w End If Next For i = 0 To .Count - 1 Sheets(2).Cells(i + 2, 1).Resize(, 4) = .items()(i)(0) Sheets(2).Cells(i + 2, 1).Offset(, 4) = .items()(i)(1)(1) Next Application.DisplayAlerts = False Sheets(2).Cells(2, 5).Resize(.Count).TextToColumns Destination:=Sheets(2).Cells(2, 5), DataType:=xlDelimited, _ Other:=True, OtherChar:="|", FieldInfo:=Array(14, 1), TrailingMinusNumbers:=True Application.DisplayAlerts = True End With End Sub

وهذه هدية لحساب الوزن المثالي بشكل تقريبي الوزن_المثالي.xlsx

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

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

طريقة مختصرة للحصول على سنة الميلاد بافتراض أن رمز الرقم القومي هو ID yyyy = (Left(ID, 1) + 17) * 100 + Mid(ID, 2, 2)

هذا خاص بالسجل المدنى وليست بطريق حسابيه

السلام عليكم الصورة غير واضحة ، الجزء السفلي الايسر من الصورة مظلل بالسواد والاسطر السفلية لا تظهر حاول ترفق صورة اكثر جودة

محاولة بدون أكواد ركبت المعادلة على أساس أن أقل راتب 3000 ريال. إذا يوجد أقل من 3000 خبرني أعدل لك المعادلة. MissingValues_01.xlsx

انا عيوني زغللت وانا اكتب الكود ...طبعا لم اجربه لحد الان وربما فيه خطأ...لكني احب مشاركة بقية الاخوة للتصحيح عملت موديول لتمرير العمر والطول ...عسى احد الاخوة يساعدنا ... لاني بجد قفلت ...يعني نعست 🥱 Function GetIdealWeight(age As Integer, height As Integer) As Double Select Case True Case age <= 24 Select Case height Case Is <= 150 GetIdealWeight = 57 Case Is <= 160 GetIdealWeight = 60 Case Else GetIdealWeight = 63 End Select Case age <= 29 Select Case height Case Is <= 150 GetIdealWeight = 60 Case Is <= 160 GetIdealWeight = 63 Case Else GetIdealWeight = 66 End Select Case age <= 39 Select Case height Case Is <= 150 GetIdealWeight = 61 Case Is <= 160 GetIdealWeight = 64 Case Else GetIdealWeight = 68 End Select Case age <= 49 Select Case height Case Is <= 150 GetIdealWeight = 64 Case Is <= 160 GetIdealWeight = 67 Case Else GetIdealWeight = 71 End Select Case Else 'age >= 50 لاكثر من 50 سنة Select Case height Case Is <= 150 GetIdealWeight = 67 Case Is <= 160 GetIdealWeight = 70 Case Else GetIdealWeight = 74 End Select End Select End Function

Try this code Sub Test() Const FIXEDPERIOD As Long = 240 Dim outputArray(), currentAmount As Long, relatedValue As Long, i As Long ReDim outputArray(2000, 3) currentAmount = 3000 For i = LBound(outputArray) + 1 To UBound(outputArray) + 1 If currentAmount <= 4000 Then relatedValue = 1350 - (currentAmount - 3000) * (1350 - 1206) / 1000 Else relatedValue = 1206 - (currentAmount - 4000) * (1206 - 1073) / 1000 End If outputArray(i - 1, 0) = currentAmount outputArray(i - 1, 1) = FIXEDPERIOD outputArray(i - 1, 2) = relatedValue outputArray(i - 1, 3) = FIXEDPERIOD * relatedValue currentAmount = currentAmount + 1 If currentAmount Mod 1000 = 0 Then relatedValue = outputArray(i - 1, 2) Next i Columns("H:K").ClearContents Range("H2").Resize(, 4).Value = Array("Salary", "Period", "Amount", "Total") Range("H3").Resize(UBound(outputArray, 1) + 1, UBound(outputArray, 2) + 1).Value = outputArray End Sub

العين لا تعلى على الحاجب وبعد اذن مهندسنا احببت المشاركه طريقة نسح النموذج بنفس الشكل والمسميات بالكود يوفر لك الجهد تكرار النماذج.accdb

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

مبدع،،، الله يوفقك،،

الأستاذ الفاضل كريم نظيم اشكرك جزيلا على سرعة الرد وعلى أعادة توضيح مكونات الرقم القومى.. وما اسأل عنه هو الفقرة التالية من توضيحك (أما بالنسبة للرقم الأخير فوضعته وزارة الداخلية للتحقق من صحة الرقم القومي وأن البطاقة ليست مزورة، ويختلف الرقم من بطاقة لأخرى بين الرقم 1 و9.) ووضع هذا الرقم من 1 إلى 9 ( وهو الرقم الرقابي) الذي استفسر عنه - ويكون ناتج عمليات حسابية على جزء من أو كل مكونات الرقم القومى ومن خلال أجراء تلك العمليات الحسابية يتضح ما إذا كان الرقم الناتج مثل الرقم الرقابي الظاهر أم لا فيكون كل الرقم القومى المكون من 14 رقم صحيح في حالة المطابقة بين ناتج الحساب و الرقم الرقابي هذا والعكس صحيح. شكر لك ومنتظر أن يفيدنا احد الاخوة

السلام عليكم ورحمة الله وبركاته وبها نبدأ اي موضوع تفضل لعله المطلوب العملاء.xlsb

اخى @محمد حسن المحمدالكود يعمل جيدا يتم تحديث ما يكتب في الخلايا ضمن QRCODE اوفيس 2010 وافيس 2021

لا تعب هل من الممكن عرض ما توصلت إلية؟ لللإفادة

اقتراح: تحديد لجنة للتحكيم واالجنة هي التي تحدد برنامج واحد للكل للعمل عليه ( اسم البرنامج موحد لكل من سيشترك - الهدف من البرنامج - الجهه المستهدفة -...........)

في حدث بعد التحديث استخدم الكود التالي.. If DCount("*", "Table1", "[datea]=" & "#" & Me.cbo1 & "#") = 0 Then MsgBox "التاريخ غير موجود!" End If

اعمل نموذج بالشكل الذي ترغبه وبالابعاد التي تريدها وليس (الحجم) ...وانسخه بعدد النماذج التي تريدها

مشاركة مع استاذي @ابوخليل عملت لك تصفية بالمركز ورقم القسط ..ويظهر لك عدد المسددين والمبالغ طبعا وضعت حقل مبالغ التسديد وارقام من عندي حتى تتوضح الصورة لديك filtering.rar

السلام عليكم ورحمة الله وبركاته استاذي محمد Mohamed Hicham ما شاء الله تبارك الله كود جميل وفكر رائع ( لا زلت احلله واتعلم منه ما شاء الله). أوافقكم الرأي بوجوب توضيح المطلوب وتحديدها وهو ما حاول Goldkamel أن يعرضه من خلال ملفين الأول متعلق بالصيانة ، والآخر متعلق ببيانات مدرسية. مع أن الهذف لازال غير واضح، مع لذلك وحسب فهمي لمطلوب وبعد الاستفادة مما طرحه الاستاذ محمد هشام ، ارفق لكم ملفين الأول متعلق بالصيانة والاخر متعلق ببيانات مدرسية اجتهدت أن تكون وفق المراد. يمكن تحديد ثلاث عناصر للبحث، ويمكن اختيار اي عمود للبحث فيه، مع الحرية في تحديد البيانات التي ترغب في عرضها في القائمة كنتيجة لعملية البحث. ملاحظات: مع اسفي على تشتتي بين الملفات المرفوعة ومحاولة تحديد المطلوب مع تقديم المقترح في ردي الأول بأهمية وجود ورقة (Prime) تتضمن القوائم التي من خلالها يتم توحيد الادخال والبحث والمعالجة لتجنب الأخطاء المطبعية عند الادخال أو البحث، وعند الرغبة في البحث في اكثر من ورقة فيجب مراعاة توحيد الأعمدة في جميع أوراق العمل. بحث بشرطين kml2.xlsm البحث فى كل اوراق العمل.xlsb

بما انك مصر على نفس الفكرة ونفس اليوزرفورم تفضل اخي يمكنك تغيير الاكواد بالشكل التالي تمت اظافة كومبوبوكس لاختيار عمود البحث و تكست بوكس للبحث بالحروف الاولى Dim f, rng, MH(), Ncol '21/02/2022 اوفيسنا Private Sub UserForm_Initialize() Dim ST Set f = Sheets("Follow up") Set rng = f.Range("A5:J" & f.[A65000].End(xlUp).Row) MH = rng.Value ST = f.[A4].CurrentRegion.Columns.Count Me.ListBox1.ColumnCount = ST Set plage = f.[A4].CurrentRegion Set plage = plage.Offset(1).Resize(plage.Rows.Count - 1) x = Me.ListBox1.Left + 8 y = Me.ListBox1.Top - 12 For i = 1 To ST Set Lab = Me.Frame1.Controls.Add("Forms.Label.1") Lab.Caption = f.Cells(4, i) Lab.Top = y Lab.Left = x x = x + f.Columns(i).Width * 1.02 temp = temp & f.Columns(i).Width * 1.02 & ";" Next temp = Left(temp, Len(temp) - 1) Me.ListBox1.ColumnWidths = temp Me.Frame1.ScrollWidth = Me.ListBox1.Width + 10 Me.Frame1.ScrollBars = 1 ' Me.ListBox1.List = plage.Value ' يمكنك تفعيل هدا الخيار لاظهار البيانات على الليست بوكس Me.ComboChoixColFiltre.List = Application.Transpose(rng.Offset(-1).Resize(1)) Me.ComboChoixColFiltre.ListIndex = 0 Me.LabelColFiltre.Caption = "فلترة ب:" & Me.ComboChoixColFiltre End Sub ''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Sub ComboChoixColFiltre_click() Me.LabelColFiltre.Caption = "فلترة ب:" & Me.ComboChoixColFiltre End Sub ''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Sub CommandButton1_Click() If Recherche.Value = Empty Then MsgBox "المرجوا ادخال معيار البحث", vbInformation + vbMsgBoxRight + vbMagBoxRt1Reading, "تعليمات" Exit Sub End If colRecherche = Me.ComboChoixColFiltre.ListIndex + 1 clé = "*" & Me.Recherche & "*": N = 0 Dim Tbl() For i = 1 To UBound(MH) If MH(i, colRecherche) Like clé Then N = N + 1: ReDim Preserve Tbl(1 To UBound(MH, 2), 1 To N) For k = 1 To UBound(MH, 2): Tbl(k, N) = MH(i, k): Next k End If Next i If N > 0 Then Me.ListBox1.Column = Tbl Else Me.ListBox1.Clear End Sub '''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Sub Recherche_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If Not iGblInhibitTextBoxEvents Then Recherche.Value = Empty End If End Sub ملاحظة البحث يكون فقط على نفس الشيت Test_User.xlsm

وعليكم السلام وحياك الله بين اخوانك القرعة.rar