تنسيق شهادة شكر .. تقرير

[ابوخليل]

السلام عليكم

في المرفق شهادة شكر  .. تظهر عندي في برنامجي الاساسي بشكل رائع مع البيانات اللازمة 

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

الى هنا وكل شيء تمام 100%

افكر فيما لو تم نشر البرنامج .. فالناس مختلفون في الذوق ووجهات النظر .. فيمكن بعضهم يريد تغيير الخلفية والآخر يريد تغيير النص الثابت في الصورة .

لذا طرحت موضوعي هذا 

اريد ان اجعل الشهادة مرنة .. امكن المستخدم من تغيير عبارة الشكر .. وتغيير الخلفية

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

عنوان الشهادة .. والعبارات اللاحقة : اريد المستخدم ان يكتبها من خلال فورم خاص بشرط امكانية التحكم بنوع الخط ومقاسه ولونه .

هل يمكن ذلك على فرضية تحويل الملف الى accde

 

 

dbs1.rar

[Foksh]

5 ساعات مضت, ابوخليل said:

السلام عليكم

 

وعليكم السلام ورحمة الله وبركاته ..

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

 

[Debug Ace]

 طيب 
سوف تكون مشاركتى بعدك مباشرة 

 

سوف تكون مشاركتى مفاجأه إستعد

تم تعديل منذ 17 ساعات بواسطه Debug Ace

[ابوخليل]

4 ساعات مضت, Foksh said:

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

 

بل اعجبني المشهد .. سلمت اناملك

4 ساعات مضت, Debug Ace said:

 طيب 
سوف تكون مشاركتى بعدك مباشرة 

سوف تكون مشاركتى مفاجأه إستعد

يا سلام  .. زاد حماسي .. احب المفاجآت في مثل هذه المواضيع

[عبد الله قدور]

السلام عليكم 

وين المرفق

9 ساعات مضت, Foksh said:

أعجبتني

 

[Foksh]

اعتذر عن التأخير ، إن شاء الله حال وصولي للكمبيوتر 🤗

[Foksh]

فكرتي المتواضعة ..

dbs2.zip

[Debug Ace]

وانا عند وعدى

هذه مشاركتى 

1- بعد فك الضغط انقل الصور الى المجلد  : TempResources

2- قم بفتح قاعدة البيانات

3- فى المستقبل فقط اضف اى صور الى المجلد  : TempResources

 

 

فى جزء لم انته منه بعد

حفظ الاعدادت كقوالب او حفظ الاعدادت لكل شهادة ان اردنا ان تكون كقاعدة بيانات للاحتفاظ بالبيانت وليس مجرد موديولر لعمل الشهادات

ويتبقى الجزء الاخير انا افكر فى الطباعة من النموذج الفرعى بشكل مباشر بدون اى تقارير 

الى لقاء قريب بعد ان اعرف ارائكم فى التطبيق والافكار البسيطة المتواضعة

 

تم تعديل منذ 4 ساعات بواسطه Debug Ace

[Debug Ace]

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

 

CertificateCustomization.zip

تم تعديل منذ 3 ساعات بواسطه Debug Ace

[ابوخليل]

58 دقائق مضت, Debug Ace said:

وانا عند وعدى

هذه مشاركتى 

ويتبقى الجزء الاخير انا افكر فى الطباعة من النموذج الفرعى بشكل مباشر بدون اى تقارير 

 

 الله .. الله .. الله  .. ما هذا !!

لا يهمني العمل الآن .. يكفيني  النص المكتوب  .. اخجلتني يارجل .. 

لحظة تعال ...

معرف جديد  + خبرة فائقة .. وخطاب يمثل المنتدى ..  اني لأشم ريح يوسف 

[Debug Ace]

13 دقائق مضت, ابوخليل said:

الله .. الله .. الله  .. ما هذا !!

لا يهمني العمل الآن .. يكفيني  النص المكتوب  .. اخجلتني يارجل .. 

لحظة تعال ...

معرف جديد  + خبرة فائقة .. وخطاب يمثل المنتدى ..  اني لأشم ريح يوسف 

موضوع الخبرة هذا ارى فيه مبالغة

وضعت الخطاب يمثل المنتدى فقط للتجربة وكنت اقصد ان يكون النص كبير لتجربة التحكم الكامل فى تكبير العناصر وتغيير مواضعها On RunTime  فى وقت العرض المباشر بدون فتح التصميم

لم افهم من يوسف هذا ؟ واضح فى لبس

حتى ان احدهم راسلنى على الخاص ظنا منه انه يعرفنى 

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

 

منتظر راى حضرتك فى الية التحكم والافكار  

تم تعديل منذ 3 ساعات بواسطه Debug Ace

[ابوخليل]

26 دقائق مضت, Debug Ace said:

منتظر راى حضرتك فى الية التحكم والافكار  

رائع جدا .. فوق المتوقع

استفسار حول اختيار نوع الخط .. هل يمكن عرض الخطوط العربية فقط

لأن قائمة الخطوط كثيرة جدا جدا .. وتأخذ وقتا كثيرا لايجاد الخط المناسب

 

1 ساعه مضت, Debug Ace said:

 

حفظ الاعدادت كقوالب او حفظ الاعدادت لكل شهادة ان اردنا ان تكون كقاعدة بيانات للاحتفاظ بالبيانت وليس مجرد موديولر لعمل الشهادات

ويتبقى الجزء الاخير انا افكر فى الطباعة من النموذج الفرعى بشكل مباشر بدون اى تقارير 

الى لقاء قريب بعد ان اعرف ارائكم فى التطبيق والافكار البسيطة المتواضعة

 

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

هذه الجديدة المرنة ستبقى واحدة ايضا ثابتة في التقرير ... لها زر للعرض بجانب الشهادة الثابتة الأولى .. وتتغير بياناتها تبعا للتحديث عليها

واسفل منهما :

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

[Moosak]

ما شاء الله تبارك الرحمن 🙂 

جميل جدا تنوع الأفكار في نفس المجال 😊👌

وأنا أيضا لدي برنامج خاص بتصميم الشهادات وتنسيقها وتوليد الشهادات لمجموعة كبيرة من الطلاب أو المتدربين أو المستلمين بشكل عام ،

وكذلك يقوم بإرسال الشهادات بالبريد الإلكتروني لكل المستهدفين ( كل متدرب أو طالب يستلم شهادته) ، وأيضا يقوم بحفظ جميع الشهادات على شكل Pdf دفعة واحدة .. 🙂 

مع إمكانيات تنسيق النص ( الخطوط والألوان ) بشكل حر ، وإضافة التواقيع ، وتغيير إطارات البرنامج .. إلخ

تصميم وتنسيق النصوص بكل أريحية

إضافة المتدربين دفعة واحدة بعدد لا محدود

معاينة بشكل مباشر

اواجهة البرنامج مع خيارات البحث وعرض تقارير وإحصائيات

 

لتحميل البرنامج :

 

تنصيب برنامج صانع الشهادات الإصدار الثالث 3.0.zip

[ابوخليل]

3 دقائق مضت, Moosak said:

وأنا أيضا لدي برنامج خاص بتصميم الشهادات وتنسيقها وتوليد الشهادات لمجموعة كبيرة من الطلاب أو المتدربين أو المستلمين بشكل عام ،

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

ولكن حاجتي في فورم ارفقه في برنامجي .

 

11 دقائق مضت, ابوخليل said:

 

استفسار حول اختيار نوع الخط .. هل يمكن عرض الخطوط العربية فقط

لأن قائمة الخطوط كثيرة جدا جدا .. وتأخذ وقتا كثيرا لايجاد الخط المناسب

 

اقصد الاستغناء عن جدول الخطوط .. وجلب الخطوط العربية مباشرة من مجلد الخطوط في وندوز

لأن المستخدم يملك خطوطا خاصه في جهازه

[Debug Ace]

موضوع اختيار نوع الخطوك العربية لا يوجد له حل

الا 

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

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

لم استخدم دالة Foksh التى استعان بها لملئ مربع سرد الخطوط فى كل مرع يتم فيها فتح النموذج 

[Foksh]

24 دقائق مضت, Debug Ace said:

موضوع اختيار نوع الخطوك العربية لا يوجد له حل

 

رداً على هذه النقطة ، وحيث أنه سبق تنفيذها سابقاً ..

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

 

 

Db3.zip

[Debug Ace]

16 دقائق مضت, Foksh said:

رداً على هذه النقطة ، وحيث أنه سبق تنفيذها سابقاً ..

اجابتى كانت من واقع خبرتى المتواضعه 

وفوق كل ذى علم عليم .  شكرا ليك على هذه المعلومة سوف اقوم بالتجربة 

[ابوخليل]

منذ ساعه, Foksh said:

رداً على هذه النقطة ، وحيث أنه سبق تنفيذها سابقاً ..

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

 

اجدت وأفدت

مع ان ما قدمه اخونا   Debug Ace   رائع لا يقاوم  .. لوجود ميزات متقدمة 

الا انني يبدو سأعتمد نسختك هذه لعدة اسباب :

- تحقق عرض الخطوط العربية فقط من وندوز

- التعامل مع التقرير مباشرة وحفظ آخر نسخة لتصبح دائمة

- جلب الخلفية مفتوح وغير مقيد 

كل هذه قريبة من عملي تقريبا .. مع بعض التعديلات اللازمة

جزاكم الله خيرا .. جميعا واجزل لكم الثواب

 

[Debug Ace]

ممتاز جدا جدا

وانا قمت بتجربة كود جلب الخطوط العربية فقط من النظام

وسوف ادمج بينه وبين طريقتى لتمكين المطور او المستخدم من تحديد خطوط معينه ان اراد ذلك فى المستقبل 

وهذا الكود المنقح 

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

 

تم تعديل منذ 9 دقائق بواسطه Debug Ace