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

لدي هذا التطبيق يقوم باختبارات ادارية متنوعة ارجو ان تبدو رأيكم فيه مع جزيل الشكر Administrative_Tests.rar

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

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

تجسيداً لفكرة التعامل مع التقرير .. هذه الفكرة المبدأية لشكل التقرير عند فتحه بعد حفظ التصميم ، وتصديره الى ملف PDF .. مسارات ومواضع العناصر في الفيديو تم تجربتها مسبقاً . لذلك هي معروفة لي .

معلمى الفاضل Foksh خالص الشكر ابدعت انتهت كل مشاكل الاحتمال الاول

شكرا جزيلا استاذ

مـــــبدع مهندســـنا الطيب , جزاك الله خير الجزاء

دائما لك نكهة خاصة مميزة 😋👌🌹 إبداع وإمتاع

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

هذه الصور تبين النتيجة تصميم ثم عرض .. العرض يتم لجميع الطلاب

ممتاز جدا جدا وانا قمت بتجربة كود جلب الخطوط العربية فقط من النظام وسوف ادمج بينه وبين طريقتى لتمكين المطور او المستخدم من تحديد خطوط معينه ان اراد ذلك فى المستقبل وهذا الكود المنقح Option Compare Database Option Explicit '=== تعريف LOGFONT === Private Type LOGFONT lfHeight As Long lfWidth As Long lfEscapement As Long lfOrientation As Long lfWeight As Long lfItalic As Byte lfUnderline As Byte lfStrikeOut As Byte lfCharSet As Byte lfOutPrecision As Byte lfClipPrecision As Byte lfQuality As Byte lfPitchAndFamily As Byte lfFaceName(0 To 31) As Byte End Type Private Const ARABIC_CHARSET As Byte = 178 Private Const DEFAULT_CHARSET As Byte = 1 '=== الـ API Declarations === #If VBA7 Then Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hdc As LongPtr) As Long Private Declare PtrSafe Function EnumFontFamiliesEx Lib "gdi32" Alias "EnumFontFamiliesExA" _ (ByVal hdc As LongPtr, lpLogFont As LOGFONT, ByVal lpEnumFontProc As LongPtr, _ ByVal lParam As LongPtr, ByVal dwFlags As Long) As Long #Else Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long Private Declare Function EnumFontFamiliesEx Lib "gdi32" Alias "EnumFontFamiliesExA" _ (ByVal hdc As Long, lpLogFont As LOGFONT, ByVal lpEnumFontProc As Long, _ ByVal lParam As Long, ByVal dwFlags As Long) As Long #End If Private m_FontList As Collection '=== الدالة الرئيسية === Public Sub LoadArabicFonts(cbo As Control, Optional IncludeNonArabic As Boolean = False) On Error GoTo ErrorHandler ' التحقق من صحة الـ Control If cbo Is Nothing Then Err.Raise 91, , "Control غير صالح" ' تهيئة القائمة بأمان SafeClearCombo cbo cbo.RowSourceType = "Value List" ' تحميل الخطوط Set m_FontList = New Collection If LoadSystemArabicFonts(IncludeNonArabic) Then PopulateComboBox cbo Else SafeAddItem cbo, "خطوط غير متوفرة" End If Exit Sub ErrorHandler: SafeClearCombo cbo SafeAddItem cbo, "خطأ في تحميل الخطوط" Debug.Print "LoadArabicFonts Error: " & Err.Number & " - " & Err.Description End Sub '=== وظائف مساعدة آمنة === Private Sub SafeClearCombo(cbo As Control) On Error Resume Next cbo.Clear On Error GoTo 0 End Sub Private Sub SafeAddItem(cbo As Control, itemText As String) On Error Resume Next cbo.AddItem itemText On Error GoTo 0 End Sub '=== تحميل الخطوط من النظام === Private Function LoadSystemArabicFonts(IncludeNonArabic As Boolean) As Boolean Dim hdc As LongPtr Dim lf As LOGFONT ' إعداد LOGFONT للخطوط العربية lf.lfCharSet = IIf(IncludeNonArabic, DEFAULT_CHARSET, ARABIC_CHARSET) ' الحصول على Device Context #If VBA7 Then hdc = GetDC(0) #Else hdc = GetDC(0&) #End If If hdc = 0 Then Exit Function On Error GoTo Cleanup EnumFontFamiliesEx hdc, lf, AddressOf EnumFontProc, 0, 0 Cleanup: LoadSystemArabicFonts = (m_FontList.Count > 0) #If VBA7 Then ReleaseDC 0, hdc #Else ReleaseDC 0&, hdc #End If On Error GoTo 0 End Function '=== Callback للخطوط === #If VBA7 Then Private Function EnumFontProc(lpelf As LOGFONT, ByVal lpntm As LongPtr, _ ByVal FontType As Long, ByVal lParam As LongPtr) As Long #Else Private Function EnumFontProc(lpelf As LOGFONT, ByVal lpntm As Long, _ ByVal FontType As Long, ByVal lParam As Long) As Long #End If On Error Resume Next Dim fName As String fName = StrConv(lpelf.lfFaceName, vbUnicode) fName = Left$(fName, InStr(fName, ChrW(0)) - 1) fName = Trim$(fName) ' فلتر TrueType فقط + تجنب التكرار If Len(fName) > 2 And (FontType And 4) = 4 And Not FontExists(fName) Then m_FontList.Add fName, fName ' Debug.Print "Font added: " & fName ' للاختبار End If EnumFontProc = 1 End Function '=== فحص وجود الخط === Private Function FontExists(fontName As String) As Boolean Dim f As Variant On Error Resume Next Set f = m_FontList(fontName) FontExists = (Err.Number = 0) On Error GoTo 0 End Function '=== ملء القائمة مع الترتيب === Private Sub PopulateComboBox(cbo As Control) Dim arr() As String Dim i As Long If m_FontList.Count = 0 Then Exit Sub ' تحويل Collection إلى Array ReDim arr(1 To m_FontList.Count) For i = 1 To m_FontList.Count arr(i) = m_FontList(i) Next i ' ترتيب سريع QuickSort arr, LBound(arr), UBound(arr) ' إضافة للـ ComboBox For i = LBound(arr) To UBound(arr) cbo.AddItem arr(i) Next i End Sub '=== Sort === Private Sub QuickSort(arr() As String, ByVal low As Long, ByVal high As Long) Dim pivot As String, i As Long, j As Long, temp As String If low < high Then pivot = arr((low + high) \ 2) i = low: j = high Do While StrComp(arr(i), pivot, vbTextCompare) < 0: i = i + 1: Wend While StrComp(arr(j), pivot, vbTextCompare) > 0: j = j - 1: Wend If i <= j Then temp = arr(i): arr(i) = arr(j): arr(j) = temp i = i + 1: j = j - 1 End If Loop While i <= j If low < j Then QuickSort arr, low, j If i < high Then QuickSort arr, i, high End If End Sub '=== وظيفة اختبار === Public Function GetArabicFontsCount() As Long Set m_FontList = New Collection LoadSystemArabicFonts False GetArabicFontsCount = m_FontList.Count End Function

رداً على هذه النقطة ، وحيث أنه سبق تنفيذها سابقاً .. جرب المرفق نفسه بعد التعديل بحيث سيتم فقط عرض الخطوط العربية ( أو التي تتعامل مع الكاركتر العربي ) في الكومبوبوكس . مع إضافة الفرز التصاعدي للأسماء :- Db3.zip

ما شاء الله تبارك الرحمن 🙂 جميل جدا تنوع الأفكار في نفس المجال 😊👌 وأنا أيضا لدي برنامج خاص بتصميم الشهادات وتنسيقها وتوليد الشهادات لمجموعة كبيرة من الطلاب أو المتدربين أو المستلمين بشكل عام ، وكذلك يقوم بإرسال الشهادات بالبريد الإلكتروني لكل المستهدفين ( كل متدرب أو طالب يستلم شهادته) ، وأيضا يقوم بحفظ جميع الشهادات على شكل Pdf دفعة واحدة .. 🙂 مع إمكانيات تنسيق النص ( الخطوط والألوان ) بشكل حر ، وإضافة التواقيع ، وتغيير إطارات البرنامج .. إلخ تصميم وتنسيق النصوص بكل أريحية إضافة المتدربين دفعة واحدة بعدد لا محدود معاينة بشكل مباشر اواجهة البرنامج مع خيارات البحث وعرض تقارير وإحصائيات لتحميل البرنامج : تنصيب برنامج صانع الشهادات الإصدار الثالث 3.0.zip

الله .. الله .. الله .. ما هذا !! لا يهمني العمل الآن .. يكفيني النص المكتوب .. اخجلتني يارجل .. لحظة تعال ... معرف جديد + خبرة فائقة .. وخطاب يمثل المنتدى .. اني لأشم ريح يوسف

االرجاء الانتظار الى الانتهاء من باقى التعديلات CertificateCustomization.zip

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