كل الانشطه

- بحثك عن الحل عن طريق الإنترنت. لم ابحث عن شئ أعرف القصة التاريخية فاللغز معروف باسم "مشكلة يوسف" نسبة إلى المؤرخ اليهودي يوسيفوس فلافيوس (Josephus Flavius) فقط وضعت المصدر اثراء للموضوع وزيادة فى المعرفة - إضافة خيارات غير مطلوبة في السؤال بسبب اعتمادك على مصدر خارجي وبسببه طال الكود. لا توجد اضافات ولذلك تم التعامل معها كمعاملات اختيارية بقيم افتراضية بناء على طرحك الغير كامل اساسا لاصل اللغز بناء على المنطق الرياضى البحت لتكتمل الفائدة لمن يريد الزيادة والاستفادة وكان ايضا ذلك هو السبب الثانى لوضع المصدر ولذلك لا توجد اى مخالفات ولا اطالة بدون داع فى الكود ونعم انا من كتبت الكود واشكرك على اطرائك

الكود عمل محترف وسريع. هناك مخالفتين منك 🙂 : - بحثك عن الحل عن طريق الإنترنت. - إضافة خيارات غير مطلوبة في السؤال بسبب اعتمادك على مصدر خارجي وبسببه طال الكود. - يمكن اختصار الكود ورفعه كمشاركة ثانية وأخيرة. إذا أنت من كتب الدالة وكتبتها بعد قراءتك للسؤال فأنت محترف وصانع متمكن للأكواد. تعلمت من دالتك استخدام كائن Collection

أستاذ يمكن الوصول للحل بدون معرفة عدد الدورات.

السلام عليكم ورحمة الله وبركاته الله يعطيك العافيه على العمل الرائع والمميز جدا اخي الفاضل @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

بالنسبة للعدد 7000 النتيجة = 5809 بالنسبة للعدد 500 النتيجة = 489 بالنسبة للعدد 10 النتيجة = 5

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

وعليكم السلام ورحمة الله وبركاته .. السؤال المنطقي هو ، في كم دورة تمت حتى وصل السجين 73 الناجي الوحيد !!!

ولما لا؟!، أسمك مألوف لدي جيدا ولكن لا أتذكر أي أحداث بيني وبينك، والحمد لله من نعم الله علي أني كثير النسيان وهذا يسهل علي التعامل مع الناس. أحييك على حماسك ولتكن أنت البادئ.

جزاكم الله خيرا على المساعده

@ابو جودي والبتعله الحوت اشرايك بشعار 😂 1- تنفيذ امر الاستخراج والطباعة صامت من غير صندوق الرسالة اجراء الطباعة وعد الصفحات انتظار فقط 2- كود مبسط ثلاث حقول 'Selected Objecit Print = (1) or PDF = (2) حدد النوع Type_Object = 2 'Name_report اسم التقرير reportName = "report1" 'If PDF Out Path File مسار الاستخراج pdfPath = CurrentProject.Path & "\" & reportName & "_" & Format(Now(), "yyyymmdd_hhnnss") & ".pdf" فقط Private Sub Comando0_Click() '=============================( Msgbox Dim strMsg_Give_Nmae As response Dim Run_Cod1 As Integer Dim MsG1 As String Dim MsG2 As String Dim MsG3 As String Dim iprgrs As Integer Dim PDF_Print_Finction As String Dim path_pdf As String Dim Report_T As String Dim Type_Object As String Dim reportName As String Dim pdfPath As String Dim totalPages As Long 'Selected Objecit Print = (1) or PDF = (2) Type_Object = 2 'Name_report reportName = "report1" 'If PDF Out Path File pdfPath = CurrentProject.Path & "\" & reportName & "_" & Format(Now(), "yyyymmdd_hhnnss") & ".pdf" '=========================================================================================================== '*****************(Only_Code)***************************** ' جلب إجمالي الصفحات للتقرير totalPages = GetReportPageCount(reportName) Me.ProgressBar3.Min = 0 Me.ProgressBar3.Max = totalPages Me.ProgressBar3.Value = 0 If Not ReportExists(reportName) Then MsG2 = "Sand Massage !" MsG1 = "تم الغاء التنفيذ " MsG3 = " لالتقرير غير موجود ولم نتمكن من العثور علية " MyMsgBox (MsG3), (MsG2), (MsG1), msg_Erorr_Job, Btn_Non, Arabic_Center ', True, 2.5 Exit Sub End If Me.Comando0.Caption = "جار التنفيذ..." Me.xc.Caption = "اجمالي الصفحات.." & totalPages For iprgrs = 1 To 6 'totalPages - 1 Me.ProgressBar3 = iprgrs Next If Type_Object = 2 Then Call externallyPDFSilent(reportName, pdfPath) Me.Comando0.Caption = "تصدير التقرير" End If If Type_Object = 1 Then Call externallyPrintSilent(reportName, pdfPath) Me.Comando0.Caption = "طباعة التقرير صامت" End If ' تحديث ProgressBar (هنا تحديث مبدئي، يمكنك توسعتها في حالة التصدير صفحة صفحة) Me.ProgressBar3.Value = totalPages Me.xc.Caption = "جاري المعالجة... 100%" Call externallyPrintSilent(reportName, pdfPath) If Dir(pdfPath) <> "" Then If Type_Object = 2 Then MsG2 = "Sand Massage !" MsG1 = "تم التنفيذ تصدير PDF " MsG3 = " لا يتوفر الان عملية تأمين الالي للبيانات بتاريخ واليوم " MyMsgBox (MsG3), (MsG2), (MsG1), msg_OK, Btn_Non, Arabic_Center ', True, 2.5 End If If Type_Object = 1 Then MsG2 = "Sand Massage !" MsG1 = "تم التنفيذ الطباعة " MsG3 = " لا يتوفر الان عملية تأمين الالي للبيانات بتاريخ واليوم " MyMsgBox (MsG3), (MsG2), (MsG1), msg_OK, Btn_Non, Arabic_Center ', True, 2.5 End If ' MsgBox "تم إنشاء ملف PDF بنجاح:" & vbCrLf & pdfPath & vbCrLf & _ ' "إجمالي الصفحات: " & totalPages, vbInformation End If End Sub تحميل المرفق https://www.mediafire.com/file/wrl147f1wl7uwmk/Silent-Print-with_Out_PDF.rar/file

ههه ..... انا اشارك ام ممنوع من المشاركة 😷

بارك الله فيك أستاذ أحمد . كما تفضلت حضرتك بالملف فإن معادلة العلامة خبور رائعة و تصلح لهذا الملف تماما فقط قم بنسخ الكود التالي في موديل جديد في في محرر الأكواد 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

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

منقول: أوقف حاكم 100 سجين في دائرة وأرقامهم من 1 إلى 100 أعطى الأول سيفا فقتل رقم 2 ثم أخذ رقم 3 السيف وقتل رقم 4 . . أخذ رقم 99 السيف وقتل رقم 100 أخذ رقم 1 السيف وقتل رقم 3 استمرت لعبة الموت حتى بقي واحد فقط. ما رقم الذي تبقى؟ محاولاتكم يجب أن تكون برمحيا وليست رياضياتيا، فرياضياتيا لها معادلة أو قانون مسمى. لكم مطلق الحرية باستخدام الأكواد أو الجداول والاستعلامات أو بهما معا أو بأي مكون من مكونات الأكسس. الحصول على الإجابة الصحيحة بحد ذاته تميز ولكن لو تم بواسطة الشفرة/الكود فقط يكون أكثر تميزا وله الأفضلية. وبالطبع كلما أختصرت المحاولة كلما كانت أفضل ولكن ليكن تركيزكم أولا على الحصول على النتيجة. لك مبرمج محاولتين ولا يسمح برقع محاولة ثالثة. لا تلجأوا إلى الذكاء الاصطناعي. حل هذا المثال هو 73، حتى تستطيعوا مراجعة نتائجكم. نريد نتائج للعدد: 10 و 500 و 7000 للمشرفين: أي كلمة في المشاركة محظورة يمكنكم تبديلها بأخرى بنفس المعنى.

السلام عليكم عادة ما يتكون الاسماء المركبة بين قوسين هكذا [ ] ولكن بدون أقواس يكون الأمر فيه شيء من الصعوبة المهم يوجد [تكة] صغيرة أو خدعة بسيطة تستطيع أن تحل بها المشكلة . تابع معي : منة الله : يتكون من (منة) ثم مسافة ثم (الله) المسافة هنا هي المشكلة , لذلك سنجعلها (نصف مسافة) وليس مسافة كاملة منة الله : لو حذفنا المسافة ستكون (منةالله) وهذا هو الاسم السليم لأن (منة) آخرها تاء مربوطة مش هاء الآن : لنفترض أن الاسم هو منه الله (بالهاء) كما هو في ملف الاكسل . كيف العمل ؟ منه الله : لو حذفنا المسافة ستكون (منهالله) وهذا غلط أذن لا نحذف المسافة ولكن نجعلها (نصف مسافة ) منه‌ الله : منه‌الله هكذا --- كيف فعلنا هذا ؟ والطريقة بسيطة اكتب منه ثم (اضغط ctrl+shift+@) ثم اكتب الله هذه الأزرار الثلاثة لا تعمل بهذه الفكرة إلا في تنسيق الكتابة العربية وليس الأنجليزية تقبل تحياتي

أشرطة مخصّصة باستخدام شريط الاوامر 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

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

اخي الكريم انت هنا تصدر مربع التسمية lblStatus التركيز مهم عند كتابة الأوامر لتنفيذ هذا الأمر يجب عليك كتابة إسم جدول أو إستعلام تحياتي

المحاضرة الثانية: Get and Post with JSON using Microsoft Access and VBA

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

في هذه المشاركة سأحاول أن اشارك حضراتكم بعض المحاضرات و الدروس التي يلقيها خبراء عالميين في مجال الاكسيس المحاضرة الاولي : Access Add-in Helper with Geoffrey L. Griffith

السلام عليكم تعديل كود التصدير الى الاكسيل عند تصدير جدول الى الاكسيل لم يظهر تسطير الاكسيل DoCmd.OutputTo acOutputQuery, "lblStatus", "ExcelWorkbook(*.xlsx)", , False, "", , acExportQualityPrint

بناءً على فكرة أخي @منتصر الانسي ، تم إضافة زر جديد ليقوم بحذف وتنظيف الليست بوكس من الإختيارات بدلاً من الخروج والعودة للواجهة التعديل في نهاية المشاركة الأولى 👆