ابو البشر

تفضل Public Function GetMissingArabicLetters(ByVal InputText As String) As String Dim strAlphabet As String Dim strOutput As String Dim i As Integer Dim char As String Dim inputLetters As Collection Dim missingCount As Integer ' الحروف العربية الأبجدية (الألف إلى الياء) strAlphabet = "ابتثجحخدذرزسشصضطظعغفقكلمنهوي" ' إنشاء مجموعة لتخزين الحروف الموجودة Set inputLetters = New Collection ' إضافة كل حرف عربي موجود في النص إلى المجموعة (منع التكرار) For i = 1 To Len(InputText) char = Mid(InputText, i, 1) If InStr(1, strAlphabet, char, vbBinaryCompare) > 0 Then On Error Resume Next inputLetters.Add char, char On Error GoTo 0 End If Next i ' بناء النتيجة بالشكل المطلوب (حرف، حرف، حرف) strOutput = "" missingCount = 0 For i = 1 To Len(strAlphabet) char = Mid(strAlphabet, i, 1) On Error Resume Next inputLetters.Item (char) ' محاولة الوصول إلى الحرف If Err.Number <> 0 Then ' إذا حدث خطأ فهذا يعني أن الحرف غير موجود If missingCount > 0 Then strOutput = strOutput & "، " ' فاصلة عربية + مسافة End If strOutput = strOutput & char missingCount = missingCount + 1 End If On Error GoTo 0 Next i ' النتيجة النهائية If missingCount = 0 Then GetMissingArabicLetters = "لا توجد حروف مفقودة" Else GetMissingArabicLetters = strOutput End If ' تنظيف الذاكرة Set inputLetters = Nothing End Function استدعيه بهذا الشكل Private Sub cmdExtract_Click() Me.txtOutput.Value = GetMissingArabicLetters(Me.txtInput.Value) End Sub

وعليكم السلام ورحمة الله وبركاته اهلا بك جرب هذا Private Sub cmdExtract_Click() Dim strInput As String Dim strAlphabet As String Dim strOutput As String Dim i As Integer Dim char As String Dim inputLetters As Collection Dim missingCount As Integer strAlphabet = "ابتثجحخدذرزسشصضطظعغفقكلمنهوي" strInput = Me.txtInput.Value Set inputLetters = New Collection For i = 1 To Len(strInput) char = Mid(strInput, i, 1) If InStr(1, strAlphabet, char, vbBinaryCompare) > 0 Then On Error Resume Next inputLetters.Add char, char On Error GoTo 0 End If Next i strOutput = "" missingCount = 0 For i = 1 To Len(strAlphabet) char = Mid(strAlphabet, i, 1) On Error Resume Next inputLetters.Item (char) If Err.Number <> 0 Then If missingCount > 0 Then strOutput = strOutput & "'، '" End If strOutput = strOutput & "'" & char & "'" missingCount = missingCount + 1 End If On Error GoTo 0 Next i If missingCount = 0 Then Me.txtOutput.Value = "لا توجد حروف مفقودة" Else Me.txtOutput.Value = strOutput End If Set inputLetters = Nothing End Sub

لم اعدل ملفك ... ولكن عند فتحة ظهرت مرتبة وبدون مشاكل

الترتيب كما تريد .... ليس هناك مشكلة والا وضح مطلوبك

طيب تستطيع عملها ام اعدله لك بارك الله فيك

تفضل .......................... ‏‏‏‏saad_A.accdb

3-4 هذه الفترة ... اليست الفترة تعني من الساعة الثالثة الى الرابعة ... ام ماذا تعني الفترة ... نورنا

طريقتين ايهما تريد ...... الطريقة الاولى ::::: طباعة يوم بيوم الطريقة الثانية :::::: طباعة ورقة واحدة لايام الاختبار ليسهل على موزيع الملاحظة العدل بين المعلين

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

اداة مفيدة ... بارك الله فيك ... هديه مقبولة

هذه هي المكتبة المطلوبة

وعليكم السلام Private Sub cm_ToExcel_Click() On Error GoTo Err_cm_ToExcel_Click Dim stDocName As String Dim Q As Integer Dim sh As Object Dim folder As Object Dim FolderPath As String Dim FilePath As String stDocName = "tbl_Teacher_" & [Year_name] Q = DCount("*", "tbl_Teacher") If Q > 0 Then ' اختيار مجلد Set sh = CreateObject("Shell.Application") Set folder = sh.BrowseForFolder(0, "اختر مجلد حفظ الملف", 0) ' لو إلغاء If folder Is Nothing Then Exit Sub FolderPath = folder.Items().Item().Path FilePath = FolderPath & "\" & stDocName & ".xls" ' 🔥 التحقق من وجود الملف If Dir(FilePath) <> "" Then If MsgBox("الملف موجود بالفعل:" & vbCrLf & FilePath & vbCrLf & vbCrLf & _ "هل تريد استبداله؟", _ vbYesNo + vbQuestion + vbMsgBoxRight, "تأكيد") = vbNo Then Exit Sub End If End If ' التصدير DoCmd.TransferSpreadsheet acExport, 8, "tbl_Teacher", FilePath, False MsgBox "تم حفظ الملف بنجاح في:" & vbCrLf & FilePath, vbInformation + vbMsgBoxRight, "تم" Else MsgBox "لا يوجد سجلات لتصديرها", vbExclamation + vbMsgBoxRight, "تنبيه" End If Exit_cm_ToExcel_Click: Exit Sub Err_cm_ToExcel_Click: MsgBox Err.Description Resume Exit_cm_ToExcel_Click End Sub

جرب هذا Dim result As VbMsgBoxResult result = MsgBox("ماذا تريد ان تفعل اضغط Yes لفتح النموذج NO لفتح التقرير Cancel للتراجع" & vbCrLf & vbCrLf & "الحمدلله", _ vbYesNoCancel + vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, "الله المستعان") If result = vbYes Then DoCmd.OpenForm "22" ElseIf result = vbNo Then DoCmd.OpenReport "33", acViewPreview ElseIf result = vbCancel Then Exit Sub ' 👈 هنا يخرج بدون أي إجراء End If

البرنامج ممتاز ... ولكن عند تشغيلة يظهر بهذه الصورة زاحفا نحو اليسار الى الاسفل يبدو بسبب هذا الكود عند الفتح Private Sub Form_Current() Me.Form.InsideHeight = 9000 Me.Form.InsideWidth = 17000 CenterFormOnScreen "frm-UserLogon" End Sub

أسأل الله العظيم رب العرش العظيم أن يشفيك ووالدتك ويشافيكما عاجلاً غير آجل شفاءً لا يغادر سقماً

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

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

طيب لو عندي اكثر من برنامج هل رقم التسجيل هو نفسه ؟ طبعا لا المفترض لكل برنامج رقم خاص

لا للاسف ..... اجرب واعطيك خبر

32

السلام عليكم ورحمة الله وبركاته مرحبا بالجميع الاوفيس 2016-32Bit النسخة المستخدمة هي tshfeerAB النتيجة ::::::::::::::::::::::::::::::

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

تفضل .. التقرير (1).accdb

جرب هذا SELECT TB1.SAMEE FROM TB1 LEFT JOIN TB2 ON TB1.SAMEE = TB2.SAMEE WHERE TB2.SAMEE IS NULL;

شكرا لاخي @ابو جودي سبقني بالحل الناجع ............................. ولكني حاولت تجميع فكرة في تصميم برنامج خاص بتعديل خصائص العناصر ::: مميزاته::::: - ممكن استخدامه للقاعدة الحالية أو قاعدة خارجية - اختيار الشكل المناسب من بين مجموعة اشكال ممكن يحتفظ بها المصمم لبرامج اخرى - اختيار نموذج من القاعدة الحالية او نموذج القاعدة الخارجية لمعاينة الشكل ( طبعا المعاينة لا تغير من خصائص عناصر النموذج ولكن للمشاهدة فقط) - يمكن تعديل الشكل ومعاينة النموذج المختار - بعد اختيار الشكل المناسب يتم الضغط عل تطبيق فيتم تطبيق الشكل على كامل النماذج في القاعدة ( سواءا الحالية _ او الخارخية ) - للاسف لم يسعفني الوقت لاكمال التصميم بسبب انشغالي هذه الفترة