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

بارك الله فيك أستاذ أحمد . كما تفضلت حضرتك بالملف فإن معادلة العلامة خبور رائعة و تصلح لهذا الملف تماما فقط قم بنسخ الكود التالي في موديل جديد في في محرر الأكواد Function kh_Names(FullName As String, ParamArray iNdex1()) As String Dim i As Integer Dim kh_Split, MyArray, Ar Dim Kh_String As String, Sn As String, Re As String On Error GoTo Err_Kh_Names '====================================== MyArray = Array("عبد ", "أبو ", "ابو ", "آل " _ , " الله", " الدين", " الإسلام", " الاسلام", " الحق") '====================================== Sn = Application.WorksheetFunction.Trim(FullName) For Each Ar In MyArray Re = Replace(Ar, " ", "^") Sn = Replace(Sn, Ar, Re) Next '====================================== kh_Split = Split(Sn, " ", , vbTextCompare) On Error Resume Next For i = 0 To UBound(iNdex1) Kh_String = Kh_String & " " & kh_Split(iNdex1(i) - 1) Next On Error GoTo 0 Kh_String = Replace(Trim(Kh_String), "^", " ") kh_Names = Kh_String Exit Function Err_Kh_Names: kh_Names = "" End Function ثم ضع المعادلة التالية في خانة اسم الأب مثلا: =kh_Names(H9;2;3;4;5) مع مراعاة الفاصلة عادية أو منقوطة حسب اصدار الاوفيس مجمع 2026بعد نتيجة ثالثة.xlsm

هذا حل رياضياتي، وأنا أوضحت أننا نريد حلا برمجيا. الغرض لنتعرف على قدارات المبرمجين ونرى "تحايلهم" في خلق افكار غير معتادة للوصول إلى الحل. شكرا لك.

حلول ذكية منقولة الحل الأول: Function Survivor(pCount As Integer) As Variant Dim Res As String Survivor = "#NUM!" If pCount < 1 Or pCount > 511 Then Exit Function Res = WorksheetFunction.Dec2Bin(pCount) Res = Mid(Res, 2) & Left(Res, 1) Survivor = WorksheetFunction.Bin2Dec(Res) End Function الحل الثاني: Function Survivor(pCount As Integer) As Integer Dim Prisoners As String Dim k As Integer, v As Integer Prisoners = String(pCount, "1") Do While Replace(Prisoners, "0", "") <> "1" k = InStr(v + 1, Prisoners, "1"): If k = 0 Then k = InStr(1, Prisoners, "1") v = InStr(k + 1, Prisoners, "1"): If v = 0 Then v = InStr(1, Prisoners, "1") Prisoners = Left(Prisoners, v - 1) & "0" & Mid(Prisoners, v + 1) Loop Survivor = InStr(1, Prisoners, "1") End Function آمل من المشرفين الكرام إقفال هذا الموضوع فقد وئد في يومه الأول. شكرا للجميع.

مرفق شيت به 1000 اختصار لبرنامج الاكسيل لتسهيل العمل منظم حسب الاصدارات للاستاذ/ محمود سيد جزاه الله خيرا 1000 اختصار للاكسيل محمود سيد.xlsx

الله يعطيك العافيه شكرا لك اخي🌹

من داخل الدالة المرفقة ، تستطيع حتى جعله = زحلون مريخي الزحلون المريخي عملة مريخية هههههههههه ( امازحك 😅 )

وعليكم السلام ورحمة الله وبركاته .. نعم أخي تستطيع ذلك ، في المرفق التالي فكرة مشتقة من أحد المشاريع القديمة ، وتقوم بنفس الطلب الذي تريده . فقط املأ الارقام وانقر زر ارسال واتس اب تم حذف بعض الوظائف الخاصة بالمشروع الأصلي .. WhatsApp Sender WF.accdb

السلام عليكم ورحمة الله وبركاته الله يعطيك العافيه على العمل الرائع والمميز جدا اخي الفاضل @Foksh عندي تقرير من صفحه واحده هل الابامكان ارسال التقرير PDF كمرفق بطريقة تلقائيه بدون ادراجه من الجهاز كيف تكون الطريقه جزاك الله خير وبارك فيك وبعلمك

وظيفة واحدة تكفي لاجراء المطلوب Public Function SplitText(inputString As String, Optional extractNumbers As Boolean = False) As String Dim i As Integer Dim r As Integer Dim lets As String Dim result() As String Dim index As Integer Dim output As String r = Len(inputString) ReDim result(1 To r) index = 0 For i = 1 To r lets = Mid(inputString, i, 1) If extractNumbers Then If IsNumeric(lets) Then index = index + 1 result(index) = lets End If Else If Not IsNumeric(lets) Then index = index + 1 result(index) = lets End If End If Next i output = "" For i = 1 To index output = output & result(i) Next i SplitText = output End Function لاستخراج النص: SplitText([txtString]) لاستخراج الارقام : SplitText([txtString],True)

الكود Public Function LastSurvivor(Optional ByVal lngN As Long = 10, Optional ByVal lngK As Long = 2) As Long Dim colPeople As Collection Dim lngIndex As Long Dim i As Long Dim killer As Long Dim totalCycles As Long Dim currentPosition As Long Set colPeople = New Collection For i = 1 To lngN colPeople.Add i Next i ReDim stepKilled(1 To lngN) lngIndex = 1 currentPosition = 1 totalCycles = 0 Do While colPeople.count > 1 lngIndex = ((lngIndex + lngK - 2) Mod colPeople.count) + 1 If lngIndex = 1 Then killer = colPeople(colPeople.count) Else killer = colPeople(lngIndex - 1) End If If currentPosition > lngIndex Then totalCycles = totalCycles + 1 End If currentPosition = lngIndex colPeople.Remove lngIndex If lngIndex > colPeople.count Then lngIndex = 1 Loop LastSurvivor = colPeople(1) End Function الكود يعتمد على المصدر https://en.wikipedia.org/wiki/Josephus_problem

وعليكم السلام ورحمه الله وبركاته راجع الملف لعله المطلوب

أشرطة مخصّصة باستخدام شريط الاوامر Custom Ribbons Using CommandBars (Adrian Bell) Using Web APIs in Access by George Young Access Version Control – Highlights along the Journey with Adam Waller Using Class Modules in the Real World

عليكم السلام تفضل مخزن 3.xlsm

تفضل مخزن 3.xlsm

بصراحة مافهمت المطلوب كامل لكن اضفت لك الجمع مخزن 3.xlsm

عليكم السلام تفضل الملف حسب الي فهمتة اتمنى يكون المطلوب مخزن 3.xlsm