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

وعليكم السلام-يمكنك استخدام هذه المعادلة =SUMPRODUCT(--(COUNTIFS(C3:G3,C3:G3,C3:G3,"<>"&"ح")>1)) عدد مرات تكرار الاسم في كل صف وكل عمود معدل1.xlsx

اسف اخي الكريم نسيت الفانك الصق هذا الفانك في النموذج ..... Public Function IsFileLocked(PathName As String) As Boolean On Error GoTo ErrHandler Dim i As Integer If Len(Dir$(PathName)) Then i = FreeFile() Open PathName For Random Access Read Write Lock Read Write As #i Lock i Unlock i Close i Else Err.Raise 53 End If ExitProc: On Error GoTo 0 Exit Function ErrHandler: Select Case Err.Number Case 70 IsFileLocked = True Case Else End Select Resume ExitProc Resume End Function

تقضل جرب Dim MWordDocCopyOf As String Dim NWordDocCopyOf As String Dim LWordDocOriginal As String Dim LWordDocCopyOf As String Dim Warning As String LWordDocOriginal = CurrentProject.Path & "\asd.docx" LWordDocCopyOf = CurrentProject.Path & "\" & "الملفات" & "\" & Format(Now(), "dd_mm_yyyy_hh_mm_AM/PM") & ".docx" FileCopy LWordDocOriginal, LWordDocCopyOf MWordDocCopyOf = LWordDocCopyOf NWordDocCopyOf = Format(Now(), "dd_mm_yyyy_hh_mm_AM/PM") & ".docx" Dim LWordDoc As Object Set LWordDoc = CreateObject("Word.Application") LWordDoc.Documents.Open MWordDocCopyOf LWordDoc.Visible = True LWordDoc.ActiveDocument.Bookmarks("A1").Select LWordDoc.Selection.InsertAfter Nz(b1.Value, "") LWordDoc.ActiveDocument.Bookmarks("A2").Select LWordDoc.Selection.InsertAfter Nz(b2.Value, "") LWordDoc.ActiveDocument.Bookmarks("A3").Select LWordDoc.Selection.InsertAfter Nz(b3.Value, "") LWordDoc.ActiveDocument.Bookmarks("A4").Select LWordDoc.Selection.InsertAfter Nz(b4.Value, "") LWordDoc.ActiveDocument.Bookmarks("A5").Select LWordDoc.Selection.InsertAfter Nz(b5.Value, "") LWordDoc.Application.Documents(NWordDocCopyOf).Save LWordDoc.Quit Set LWordDoc = Nothing Warning = MsgBox("تم تصدير البيانات للملف ....... هل تريد فتح الملف المصدر", vbYesNo + vbQuestion, "تحذير") If Warning = vbYes Then Application.FollowHyperlink MWordDocCopyOf Else DoCmd.CancelEvent

احسنت بارك الله فيك ووسع الله فى رزقك

بارك الله فيك وزادك الله من فضله

تفضل هذه بنواة 64 بت -بعد اذن جميع الأساتذة فالملف ليس به اى مشكلة فإن واجهتكم مشكلة فاعلم انها من عندك انت فلابد كما أخبرنا من تحميل الأداة والمكتبة الناقصة رابط تحميل السيلينيوم https://github.com/florentbr/SeleniumBasic/releases/download/v2.0.9.0/SeleniumBasic-2.0.9.0.exe رابط تحميل الدريفر الخاص بالسلينيوم https://chromedriver.storage.googleapis.com/102.0.5005.27/chromedriver_win32.zip الكروم درايفر لابد ان يكون اصداره مثل اصدار الكروم المصطب على جهازك نظام ادارة شؤون التلاميذ الاصدار 1.00.rar

وده تعديل اضافى ليظهر كما بالصوره للتقرير Q_bait_mon بالتوفيق TEST-22.accdb

ماشاء الله يا @ابو البشر احسنت بارك الله فيك ................... وعالم متخفي

واياك .... جزاك الله خيرا على هذه الدعوات ولك بمثله ..

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

تفضل ...... Dim MWordDocCopyOf As String Dim NWordDocCopyOf As String Dim LWordDocOriginal As String Dim LWordDocCopyOf As String Dim Warning As String LWordDocOriginal = CurrentProject.Path & "\asd.docx" LWordDocCopyOf = CurrentProject.Path & "\" & "الملفات" & "\" & Format(Now(), "dd_mm_yyyy_hh_mm_AM/PM") & ".docx" If IsFileLocked(LWordDocCopyOf) = True Then MsgBox "يرجى غلق ملف الوورد!" Application.FollowHyperlink LWordDocCopyOf Exit Sub Else FileCopy LWordDocOriginal, LWordDocCopyOf MWordDocCopyOf = LWordDocCopyOf NWordDocCopyOf = Format(Now(), "dd_mm_yyyy_hh_mm_AM/PM") & ".docx" Dim LWordDoc As Object Set LWordDoc = CreateObject("Word.Application") LWordDoc.Documents.Open MWordDocCopyOf LWordDoc.Visible = True LWordDoc.ActiveDocument.Bookmarks("A1").Select LWordDoc.Selection.InsertAfter Nz(b1.Value, "") LWordDoc.ActiveDocument.Bookmarks("A2").Select LWordDoc.Selection.InsertAfter Nz(b2.Value, "") LWordDoc.ActiveDocument.Bookmarks("A3").Select LWordDoc.Selection.InsertAfter Nz(b3.Value, "") LWordDoc.ActiveDocument.Bookmarks("A4").Select LWordDoc.Selection.InsertAfter Nz(b4.Value, "") LWordDoc.ActiveDocument.Bookmarks("A5").Select LWordDoc.Selection.InsertAfter Nz(b5.Value, "") LWordDoc.Application.Documents(NWordDocCopyOf).Save End If LWordDoc.Quit Set LWordDoc = Nothing Warning = MsgBox("تم تصدير البيانات للملف ....... هل تريد فتح الملف المصدر", vbYesNo + vbQuestion, "تحذير") If Warning = vbYes Then Application.FollowHyperlink MWordDocCopyOf Else DoCmd.CancelEvent End If

طيب جرب تجاهل الحل السابق بالكامل وجرب تضيف السطر ده فقط فى دايرة Do Loop على الملف الاصلى دون اي اكود أخرى If Application.Visible = True Then Exit Sub Private Sub UserForm_Activate() Me.BackColor = RGB(40, 116, 166) Me.Frame1.BackColor = RGB(40, 116, 166) Me.Label1.Caption = Date Me.Label2.Caption = Format(Date, "ddd") Do If Application.Visible = True Then Exit Sub Me.Label3.Caption = Time DoEvents Loop End Sub

السلام عليكم المشكله هى Do-Loop فى كود الفورم mainform Private Sub UserForm_Activate() Me.BackColor = RGB(40, 116, 166) Me.Frame1.BackColor = RGB(40, 116, 166) Me.Label1.Caption = Date Me.Label2.Caption = Format(Date, "ddd") Do Me.Label3.Caption = Time DoEvents Loop End Sub ودي بتخللى الفورم شغال الخلفيه طيب ايه الحل 1- ها نعرف المتغير فى اول الفورم خالص وليكن Dim StopClock as Boolean 2- ها نتأكد انه False فى بدايه تشغيل ال form من من حدث Private Sub UserForm_Initialize() StopClock = False End Sub 3- هانضيف شرط فى دائرة ال Do انها ما تعملش حاجه لو StopClock= true Private Sub UserForm_Activate() Me.BackColor = RGB(40, 116, 166) Me.Frame1.BackColor = RGB(40, 116, 166) Me.Label1.Caption = Date Me.Label2.Caption = Format(Date, "ddd") Do If StopClock = True Then Exit Sub Me.Label3.Caption = Time DoEvents Loop End Sub هانتأكد ان قيمة المتغير True قبل ما نعمل unload للفورم Private Sub CommandButton6_Click() Application.Visible = True StopClock = True Unload Me End Sub لما تدوس على الزرار بعد كده هتلاقى الشيتات مفتوحه عادي والايديت عادي جرب الملف المرفق dwork.xlsm

همة مشكورة بارك الله فيك وزادك الله من فضله ..طبعاً رائع هدية مقبولة وموفق دائماَ

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

استبدل الكود بهذا ..... Dim MWordDocCopyOf As String Dim LWordDocOriginal As String Dim LWordDocCopyOf As String Dim Warning As String LWordDocOriginal = CurrentProject.Path & "\asd.docx" LWordDocCopyOf = CurrentProject.Path & "\" & "الملفات" & "\" & Format(Now(), "dd_mm_yyyy_hh_mm_AM/PM") & ".docx" FileCopy LWordDocOriginal, LWordDocCopyOf MWordDocCopyOf = LWordDocCopyOf Dim LWordDoc As Object Set LWordDoc = CreateObject("Word.Application") LWordDoc.Documents.Open MWordDocCopyOf LWordDoc.Visible = True LWordDoc.ActiveDocument.Bookmarks("A1").Select LWordDoc.Selection.InsertAfter Nz(b1.Value, "") LWordDoc.ActiveDocument.Bookmarks("A2").Select LWordDoc.Selection.InsertAfter Nz(b2.Value, "") LWordDoc.ActiveDocument.Bookmarks("A3").Select LWordDoc.Selection.InsertAfter Nz(b3.Value, "") LWordDoc.ActiveDocument.Bookmarks("A4").Select LWordDoc.Selection.InsertAfter Nz(b4.Value, "") LWordDoc.ActiveDocument.Bookmarks("A5").Select LWordDoc.Selection.InsertAfter Nz(b5.Value, "") LWordDoc.Application.Documents(Format(Now(), "dd_mm_yyyy_hh_mm_AM/PM") & ".docx").Save LWordDoc.Quit Set LWordDoc = Nothing Warning = MsgBox("تم تصدير البيانات للملف ....... هل تريد فتح الملف المصدر", vbYesNo + vbQuestion, "تحذير") If Warning = vbYes Then Application.FollowHyperlink CurrentProject.Path & "\" & "الملفات" & "\" & Format(Now(), "dd_mm_yyyy_hh_mm_AM/PM") & ".docx" Else DoCmd.CancelEvent End If كل هذا ممكن .... بس خلينا نخلص من اخونا @حامل المسك وابشر استاذ @عمر ضاحى

اللهم صلى وسلم وبارك عليك سيدى يا رسول الله ... أكرمك الله استاذ حسين وزادك الله من فضله

فقط المشكلة كانت لديك فى تنسيق خلية الرقم القومى ةالرقم التأمينى لأنك قمت بعمل تنسيق لتلك الخلايا على أنها تاريخ وليس رقم وشكراً

ممتاز استاذ مجدى بارك الله فيك وزادك الله من فضله

وفيك بارك ... سعدت بمرورك على ردي ... جزاك الله خيرا .. منكم نتعلم

انا شخصيا اجل واحترم مايقدمه الاستاذ احمد عبد المنعم جزاه الله خير جزاء المحسنين

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

تسوية عهدة.xlsm سلام عليكم هذا ملف لتسوية العهدة النقدية للموظفين أولا : يرجي كتابة أسماء حاملي العهد في شيت الرئيسية وأيضا رصيد اول المدة ثانيا : ندخل على صفحة الادخال لعمل التسويات ثالثا : من صفحة التقارير يمكنك طباعة العهدة بشكل جميل بتاريخ العهدة ملحوظة ضروري كتابه تاريخ العهد في نفس تاريخ التسوية وليست تواريخ الفواتير تحياتي لكم ♥

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

لقد سبقوني وجزاهم الله خيرا

وعليكم السلام 🙂 هل الهدف معرفة الفرق بين التاريخين ؟ >> في هذه الحالة ليس منطقيا أن نحسب الشهور كلها ل 30 يوم !! وإذا كان الهدف أنك تريد معرفة ما هو التاريخ الذي يصادفه لو أضفنا 30 يوم إلى تاريخ البداية مثلا .. فهذا ممكن عن طريق الدالة DateAdd ..

جرب تضيف الاكواد على اصل الملف عندك انا كاتبها بالتفصيل ...ان شاء الله تشتغل كويس

تفضل ..... جرب .... legan.rar

السلام عليكم عساكم دائما بخير ان شاء الله كما هو مذكور في العنوان ♥استلامات العمالة.xlsm يارب يعجبكم

‏‏سند صرف.xlsm تحياتي ♥

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

تفضل اخي الكريم ♥ ورقة (1).xls الورقة الاولى فقط اللي تدخل فيها البيانات والباقي بتلاقيه موجود مثل التقارير

وعليكم السلام تفضل أخي الكريم المصنف1.xlsm

شكرا استاذي العزيز بارك الله فيك و في اعمالك جعلها الله في ميزان حسناتك الان يعتبر العمل ان شاء الله اكتمل

احدف بياناتك قي الشيت الثاني ابتداء من BI1 Sub test() Dim r As Range Sheets("sheet2").UsedRange.Clear With Sheets("sheet1") Set r = .[t1:t2] With .Range("t3", .Range("t" & Rows.Count).End(xlUp)).Resize(, 8) r(2).Formula = "=countblank(" & .Rows(2).Range("c1").Resize(, 6).Address(0, 0) & ")<6" .AdvancedFilter 2, r, Sheets("sheet2").Cells(61) End With r.Clear End With End Sub

استخدم هذا الكود ..... Dim LWordDocOriginal As String Dim LWordDocCopyOf As String Dim Warning As String LWordDocOriginal = CurrentProject.Path & "\asd.docx" LWordDocCopyOf = CurrentProject.Path & "\" & "الملفات" & "\" & Format(Date, "dd-mm-yyyy") & ".docx" FileCopy LWordDocOriginal, LWordDocCopyOf Dim LWordDoc As Object Set LWordDoc = CreateObject("Word.Application") LWordDoc.Documents.Open CurrentProject.Path & "\" & "الملفات" & "\" & Format(Date, "dd-mm-yyyy") & ".docx" LWordDoc.Visible = True LWordDoc.ActiveDocument.Bookmarks("A1").Select LWordDoc.Selection.InsertAfter b1 LWordDoc.ActiveDocument.Bookmarks("A2").Select LWordDoc.Selection.InsertAfter b2 LWordDoc.ActiveDocument.Bookmarks("A3").Select LWordDoc.Selection.InsertAfter b3 LWordDoc.ActiveDocument.Bookmarks("A4").Select LWordDoc.Selection.InsertAfter b4 LWordDoc.ActiveDocument.Bookmarks("A5").Select LWordDoc.Selection.InsertAfter b5 LWordDoc.Application.Documents(Format(Date, "dd-mm-yyyy") & ".docx").Save LWordDoc.Quit Set LWordDoc = Nothing Warning = MsgBox("تم تصدير البيانات للملف ....... هل تريد فتح الملف المصدر", vbYesNo + vbQuestion, "تحذير") If Warning = vbYes Then Application.FollowHyperlink CurrentProject.Path & "\" & "الملفات" & "\" & Format(Date, "dd-mm-yyyy") & ".docx" Else DoCmd.CancelEvent End If

وعليكم السلام استخدم Not In (500;501;502;503;504;505)

وعليكم السلام ورحمة الله جرب كده ...... OpenClsword (CurrentProject.Path & "\asd.docx") Objwrd.ActiveDocument.Bookmarks("A1").Select Objwrd.Selection.InsertAfter Jhhh Objwrd.ActiveDocument.Bookmarks("A1").Select Objwrd.Selection.InsertAfter Subsader Objwrd.ActiveDocument.Bookmarks("A3").Select Objwrd.Selection.InsertAfter Datesader Objwrd.ActiveDocument.Bookmarks("A4").Select Objwrd.Selection.InsertAfter annexes Objwrd.ActiveDocument.Bookmarks("A3").Select Objwrd.Selection.InsertAfter sndOfficialn Objwrd.SaveAs2 CurrentProject.Path & "\" & Date & ".docx" Objwrd.Close False

عليكم السلام ورحمة الله وبركاته الأمر hide يستعمل في إخفاء النموذج فقط وليس إغلاقه كاملا وهذا يعني إمكاية استعمال جميع المتغيرات والكائنات المستعملة في النموذج الأمر unload يستعمل في إعلاف النموذج كاملا فلا يمكن استعمال أي من متغيراته أو كائناته ويمكن استعمال الأمرين من داخل النموذج me.hide unload me أو من خارجه userform1.hide unload userform1 أما end فلا علاقة لها بالنموذج وإغلاقه فهي تستعمل للتعبير عن نهاية بعض الأوامر مثل End [Function | Sub | With | Select | Type | Enum | If ] أما exit فتستعمل للخروج من بعض الأوامر مثل Exit [ Do | For | Function | Select | Sub ] بالتوفيق

وعليكم السلام-يمكنك استخدام هذه المعادلة لطلبك =INDEX(القائمة!$C:$F,MATCH(C6,القائمة!$B:$B,0),MATCH(D5,القائمة!$C$6:$F$6,0)) المطلوب1.xlsx

أحسنت استاذ مجدى بارك الله فيك وزادك الله من فضله

لعل هذا هو المطلوب تم استعمال الخلية T1 لاختيار طريقة الطباعة فردي أو جماعي تغيير كود الاجراء text إلى Sub text() printtype = N.Range("t1") If printtype = "فردي" Then x = InputBox("من فضلك ادخل الرقم القومى مع تحياتى اشرف صبور ") N.Range("t2") = x On Error GoTo mm i = Application.WorksheetFunction.Match(N.Range("t2"), DB.Range("c:c"), 0) Call filldata(i) N.PrintPreview Call cler Exit Sub mm: MsgBox "الرقم القومى غير موجود مع تحياتى اشرف صبور" Else lr = DB.Cells(Rows.Count, 3).End(3).Row For r = 13 To lr filldata (r) ActiveSheet.PrintOut Next r Call cler End If End Sub وفي حالة اختيار جماعية يتم طباعة الأرقام من الصف 13 إلى آخر صف مكتوب فيه lr = DB.Cells(Rows.Count, 3).End(3).Row For r = 13 To lr وحتى لا نكرر كود تعبئة الخلايا تم فصل كود التعبئة في إجراء منفصل مع تمرير رقم الصف المراد طباعته إليه Sub filldata(i) N.Range("c7") = DB.Cells(i, "g") N.Range("c8") = DB.Cells(i, "ci") N.Range("g7") = DB.Cells(i, "b") N.Range("g8") = DB.Cells(i, "c") N.Range("c9") = DB.Cells(i, "f") N.Range("c13") = DB.Cells(i, "i") N.Range("e13") = DB.Cells(i, "j") N.Range("b16") = DB.Cells(i, "l") N.Range("c16") = DB.Cells(i, "m") N.Range("d16") = DB.Cells(i, "n") N.Range("b22") = DB.Cells(i, "af") N.Range("b23") = DB.Cells(i, "ao") N.Range("b24") = DB.Cells(i, "ax") N.Range("b25") = DB.Cells(i, "bg") N.Range("d20") = DB.Cells(i, "q") N.Range("d21") = DB.Cells(i, "y") N.Range("d22") = DB.Cells(i, "ah") N.Range("d23") = DB.Cells(i, "aq") N.Range("d24") = DB.Cells(i, "az") N.Range("d25") = DB.Cells(i, "bi") N.Range("d26") = DB.Cells(i, "bq") N.Range("d27") = DB.Cells(i, "by") N.Range("d29") = DB.Cells(i, "cf") N.Range("g20") = DB.Cells(i, "w") N.Range("g21") = DB.Cells(i, "ae") N.Range("g22") = DB.Cells(i, "an") N.Range("g23") = DB.Cells(i, "aw") N.Range("g24") = DB.Cells(i, "bf") N.Range("g25") = DB.Cells(i, "bo") N.Range("g26") = DB.Cells(i, "bw") N.Range("g27") = DB.Cells(i, "ce") N.Range("g28") = DB.Cells(i, "k") N.Range("f29") = DB.Cells(i, "cg") N.Range("e20") = DB.Cells(i, "s") N.Range("e21") = DB.Cells(i, "aa") N.Range("e22") = DB.Cells(i, "aj") N.Range("e23") = DB.Cells(i, "as") N.Range("e24") = DB.Cells(i, "bb") N.Range("e25") = DB.Cells(i, "bk") N.Range("e26") = DB.Cells(i, "bs") N.Range("e27") = DB.Cells(i, "ca") N.Range("f20") = DB.Cells(i, "t") N.Range("f21") = DB.Cells(i, "ab") N.Range("f22") = DB.Cells(i, "ak") N.Range("f23") = DB.Cells(i, "at") N.Range("f24") = DB.Cells(i, "bc") N.Range("f25") = DB.Cells(i, "bl") N.Range("f26") = DB.Cells(i, "bt") N.Range("f27") = DB.Cells(i, "cb") N.Range("c31") = DB.Cells(i, "cl") N.Range("g31") = DB.Cells(i, "cm") End Sub وأنصح دائما بدراسة وفهم الكود ومتغيراته وكائناته جيدا قبل تطبيقه على شيت آخر بالتوفيق طباعة فردي أو جماعي.xlsm

أحسنت استاذ مجدى موضوع رائع بارك الله فيك وزادك الله من فضله

تفضل أخي العزيز عملتها لك في زر عند النقر على الأزرار الفرعية .. وكذلك عند مرور الماوس مرة تفتح ومرة تقفل 😁 test (2).rar

السلام عليكم ورحمة الله وبركاته،... كثيراً مانحتاج في برامجنا الى ( اسم مُدخل البيانات ) أي الذي قام بكتابة الفاتورة او تعديل أمر ما او طباعة ...الخ نريد أن نعرف من الشخص الذي قام بهذه العملية خصوصاً اذا كانت قاعدة البيانات قد تم ربطها بشكل شبكة ( سلسلة كومبيوترات متصلة بقاعدة البيانات ) كنا نستعمل الطريقة التقليدية أولا: بإنشاء جدول لتسجيل اسم المستخدم الحالي الذي يستخدم قاعدة البيانات في حال مروره بنموذج تسجيل الدخول ثانيا: نقوم بتخزينه في متغير Veriable من نوع String مثلاً وعند المرور بنموذج تسجيل الدخول يتم اسناد القيمة للمتغير في حال كان اليوزر والباسورد صحيحين Public CurrentUserName As String الكلام في الطريقتين صحيح، لكن في الطريقة الأولى سيبقى محتفظاً في اسم المستخدم حتى في حالة إغلاق الأكسس أجبارياً اما الطريقة الثانية فأن هذا المتغير سيفقد القيمة التي قمنا بتخزينها به عند ظهور أول رسالة خطأ من الأكسس جراء تطبيق أمر ما او أي عملية If قمت بكتابتها، بمجرد ظهور رسالة الخطأ ستختفي القيمة من المتغير CurrentUserName ونُصبح في مهب الريح ، حسناً لذلك سنقوم بإستخدام ( TempVars ) دعنا نسميها المخزن، نقوم بخزن اي قيمة بداخلها وتكون بهيئة ( Global Veriables ) يمكن استدعائها من أي مكان وسيتم تصفيرها بعد أغلاق الأكسس أجبارياً او إختيارياً ولن تمحى القيمة بعد ظهور رسالة خطأ كما أوضحت سابقاً. أضافة قيمة: TempVars.Add "CurrentUserName", "semo" إحضار القيمة: MsgBox TempVars("CurrentUserName") يمكنك إسناد الكثير من القيم لـ TempVars والإستفادة منها. لتفاصيل أكثر يمكنكم قراءة المقال من شركة مايكروسوفت: https://docs.microsoft.com/en-us/office/vba/api/access.tempvars.add أي سؤال أنا موجود، تحياتي لكم .

السلام عليكم مينفعش الكل يشارك وأنا واقف أتفرج - معرفش غير أنزل الملعب وأقوم بدور راس حربة - تفضل المرفق التالي به دالتين : الدالة الأولى تقوم باستخراج الأرقام من ضمن النص ، وفيه تفصيل ليها بالملف المرفق ، والثانية تقوم بجمع الأرقام Digits والله المستعان .. Extract Number - Sum Digits Function.rar

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

أخي الفاضل انت محظوظ جدا على فكرة، كل عمالقة المنتدي تواجدوا بموضوعك وما شاء الله بدل الحل حلول .. انت اللى مش عاوز تتعب نفسك وعاوز حاجة سهلة بدل المعادلات الطويلة علما ان حلول الأساتذة الكرام تفي بالغرض وزيادة عامة مرفق ملف مجمع به كافة حلول الأساتذة الأفاضل أ.سليم وأ.أبو تراب جزاهم الله كل خير وللتسهيل عليك هناك حل آخر مرفق الا وهو دالة تم تسميتها ( SumNo ) تقوم بإحضار الرقم فقط من الخلية انظر الملف المرفق تحياتي مثال.rar

السلام عليكم انا مع ملك المعادلات فى كلامه ولكن اليك محاولة حل بعد حلول الاساتذه الافاضل =LOOKUP(9999999999;1*(MID(A2;SMALL(FIND({0;1;2;3;4;5;6;7;8;9};A2&"0123456789");1);ROW($A$1:$A$23)))) مثال.rar

السلام عليكم جرب الملف التالي sum of mix cell.xlsx