Foksh

مارس 9

10 دقائق مضت, محمد التميمي said:

السلام عليكم : تم اليوم وبحمد الله تطبيق مثال الباركود على القاعة الاصلية التي تحتوي على 66245 سجل وتطبع اربع انواع من الهويات ( البطاقات البلاستيكية) وكان العمل رائع جدا . والنتائج جيدة والحمد لله . بارك الله بجهودك استاذي الفاضل منكم نتعلم وشكرا جزيلا وجعله الله في ميزان حسناتك . ومن الله التوفيق.

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

تبارك الرحمن ، ما شاء الله ، جزاكم الله كل الخير ، والله يعطيك العافية 🤗

مارس 9

15 ساعات مضت, فؤاد الدلوي said:

استاذ @Foksh شكراً لكن ما زال هناك خطأ ممكن مرفق

قد يكون الحقل في الجدول نصي وليس رقمي,,
جرب التعديل التالي :-

Private Sub txt_AfterUpdate()
Dim selectedYear As Integer
selectedYear = Me.txt

Me.Filter = "[TOTALSHY] = 0 OR ([yearshy] <> '" & selectedYear & "' AND [TOTALSHY] <> 0)"
Me.FilterOn = True
End Sub

مارس 9

منذ ساعه, ابو جودي said:

طيب ممكن مشاركة اثراء للموضوع يا استاذ @Foksh
ايه رايك طالما كده كده هنعمل اكواد داخل موديول نتوسع فى الافكار ونشطح بخيالنا حبتين علشان يكون قفلنا كل المشاكل الممكن حدوثها

شوف يا سيدى انا اقصد بالمشاكل مثلا عندك شهر ابريل ممكن يكون أبريل وشهر يونيه ممكن يكون يونيو
ده على سبيل المثال وليس الحصر

خلينا بقه نستخدم القواميس الممتعه فى شغلها ونكتب الدالخ من خلالها بالشكل ده

Option Compare Database
Option Explicit

' تهيئة القواميس مرة واحدة فقط لتوفير الأداء
Dim monthsDict As Object
Dim daysDict As Object

' دالة لإنشاء قاموس ديناميكيًا
Public Function CreateDictionary() As Object
    Set CreateDictionary = CreateObject("Scripting.Dictionary")
End Function

' تهيئة القواميس عند بدء التشغيل
Sub InitializeDictionaries()
    If monthsDict Is Nothing Then Set monthsDict = InitializeMonthsDictionary()
    If daysDict Is Nothing Then Set daysDict = InitializeDaysDictionary()
End Sub

Function GetDaysInfo(monthInput As Variant, Optional yearValue As Variant = -1, Optional targetDay As Variant = "MonthDays") As Variant
    Dim MonthNumber As Long
    Dim firstDay As Date
    Dim totalDays As Long
    Dim daysArray(1 To 7) As Long
    Dim currentDate As Date
    Dim result As Variant
    Dim i As Long
    
    ' تهيئة القواميس مرة واحدة
    InitializeDictionaries
    
    '--- تعديل رئيسي: التحقق من السنة ---
    If IsMissing(yearValue) Or yearValue = -1 Then
        yearValue = Year(Date) ' استخدام السنة الحالية إذا لم تُحدد
    Else
        ' التأكد من أن yearValue هو رقم صحيح
        If Not IsNumeric(yearValue) Then
            GetDaysInfo = "خطأ: السنة يجب أن تكون رقمًا"
            Exit Function
        End If
        yearValue = CLng(yearValue)
    End If
    
    ' تعيين السنة الحالية إذا لم تُمرر
    If yearValue = 0 Then yearValue = Year(Date)
    
    ' معالجة إدخال الشهر
    If IsNumeric(monthInput) Then
        MonthNumber = CLng(monthInput)
    Else
        MonthNumber = GetNumberFromDict(monthsDict, monthInput)
    End If
    
    If MonthNumber < 1 Or MonthNumber > 12 Then
        GetDaysInfo = "خطأ في الشهر: " & monthInput & vbCrLf & "الأشهر المتاحة: " & Join(monthsDict.Keys, ", ")
        Exit Function
    End If
    
    ' حساب أيام الشهر
    totalDays = Day(DateSerial(yearValue, MonthNumber + 1, 0))
    firstDay = DateSerial(yearValue, MonthNumber, 1)
    
    ' تهيئة المصفوفة
    For i = 1 To 7
        daysArray(i) = 0
    Next i
    
    ' حساب أيام الأسبوع (الأحد = 1)
    For i = 0 To totalDays - 1
        currentDate = firstDay + i
        daysArray(Weekday(currentDate, vbSunday)) = daysArray(Weekday(currentDate, vbSunday)) + 1
    Next i
    
    ' معالجة طلب اليوم المستهدف
    Select Case True
        Case targetDay = "MonthDays" Or targetDay = "أيام_الشهر"
            result = totalDays
        Case targetDay = "ALL" Or targetDay = "الكل"
            result = daysArray
        Case Else
            Dim dayCode As Long
            dayCode = GetNumberFromDict(daysDict, targetDay)
            If dayCode = 0 Then
                GetDaysInfo = "خطأ في اليوم: " & targetDay & vbCrLf & "الأيام المتاحة: " & Join(daysDict.Keys, ", ")
                Exit Function
            End If
            result = daysArray(dayCode)
    End Select
    
    GetDaysInfo = result
End Function

Function InitializeMonthsDictionary() As Object
    Dim dict As Object
    Set dict = CreateDictionary()
    
    With dict
        ' شهر 1
        .Add "1", 1
        .Add "jan", 1
        .Add "january", 1
        .Add "يناير", 1
        .Add "ينا", 1
        .Add "ين", 1
        
        ' شهر 2
        .Add "2", 2
        .Add "feb", 2
        .Add "february", 2
        .Add "فبراير", 2
        .Add "فبر", 2
        .Add "فب", 2
        
        ' شهر 3
        .Add "3", 3
        .Add "mar", 3
        .Add "march", 3
        .Add "مارس", 3
        .Add "ماس", 3
        .Add "ما", 3
        
        ' شهر 4
        .Add "4", 4
        .Add "apr", 4
        .Add "april", 4
        .Add "أبريل", 4
        .Add "إبريل", 4
        .Add "ابريل", 4
        .Add "ابر", 4
        
        ' شهر 5
        .Add "5", 5
        .Add "may", 5
        .Add "مايو", 5
        .Add "ماي", 5
        
        ' شهر 6
        .Add "6", 6
        .Add "jun", 6
        .Add "june", 6
        .Add "يونية", 6
        .Add "يونيه", 6
        .Add "يونيو", 6
        .Add "يون", 6
        
        ' شهر 7
        .Add "7", 7
        .Add "jul", 7
        .Add "july", 7
        .Add "يوليو", 7
        .Add "يوليه", 7
        .Add "يولية", 7
        .Add "يول", 7
        
        ' شهر 8
        .Add "8", 8
        .Add "aug", 8
        .Add "august", 8
        .Add "أغسطس", 8
        .Add "اغسطس", 8
        .Add "أغس", 8
        
        ' شهر 9
        .Add "9", 9
        .Add "sep", 9
        .Add "september", 9
        .Add "سبتمبر", 9
        .Add "سبت", 9
        
        ' شهر 10
        .Add "10", 10
        .Add "oct", 10
        .Add "october", 10
        .Add "أكتوبر", 10
        .Add "اكتوبر", 10
        .Add "أكت", 10
        
        ' شهر 11
        .Add "11", 11
        .Add "nov", 11
        .Add "november", 11
        .Add "نوفمبر", 11
        .Add "نوف", 11
        
        ' شهر 12
        .Add "12", 12
        .Add "dec", 12
        .Add "december", 12
        .Add "ديسمبر", 12
        .Add "ديس", 12
    End With
    
    Set InitializeMonthsDictionary = dict
End Function

Function InitializeDaysDictionary() As Object
    Dim dict As Object
    Set dict = CreateDictionary()
    
    With dict
        ' الأحد
        .Add "1", 1
        .Add "sun", 1
        .Add "sunday", 1
        .Add "الأحد", 1
        .Add "الاحد", 1
        .Add "أحد", 1
        .Add "احد", 1
        .Add "ح", 1
        
        ' الإثنين
        .Add "2", 2
        .Add "mon", 2
        .Add "monday", 2
        .Add "الإثنين", 2
        .Add "الاثنين", 2
        .Add "إثنين", 2
        .Add "اثنين", 2
        .Add "ن", 2
        
        ' الثلاثاء
        .Add "3", 3
        .Add "tue", 3
        .Add "tuesday", 3
        .Add "الثلاثاء", 3
        .Add "ثلاثاء", 3
        .Add "ث", 3
        
        ' الأربعاء
        .Add "4", 4
        .Add "wed", 4
        .Add "wednesday", 4
        .Add "الأربعاء", 4
        .Add "الاربعاء", 4
        .Add "أربعاء", 4
        .Add "ر", 4
        
        ' الخميس
        .Add "5", 5
        .Add "thu", 5
        .Add "thursday", 5
        .Add "الخميس", 5
        .Add "خميس", 5
        .Add "خ", 5
        
        ' الجمعة
        .Add "6", 6
        .Add "fri", 6
        .Add "friday", 6
        .Add "الجمعة", 6
        .Add "الجمعه", 6
        .Add "جمعة", 6
        .Add "جم", 6
        .Add "ج", 6
        
        ' السبت
        .Add "7", 7
        .Add "sat", 7
        .Add "saturday", 7
        .Add "السبت", 7
        .Add "سبت", 7
        .Add "س", 7
    End With
    
    Set InitializeDaysDictionary = dict
End Function

Function GetNumberFromDict(dict As Object, key As Variant) As Long
    key = LCase(Trim(CStr(key)))
    If dict.Exists(key) Then
        GetNumberFromDict = dict(key)
    Else
        GetNumberFromDict = 0
    End If
End Function

ودى كل نتائج الكود من خلال استعلام

SELECT 
    shr,
    GetDaysInfo([shr], 0, "MonthDays") AS عدد_أيام_الشهر,
    GetDaysInfo([shr], 0, "Sunday") AS عدد_أيام_الأحد,
    GetDaysInfo([shr], 0, "Monday") AS عدد_أيام_الاثنين,
    GetDaysInfo([shr], 0, "Tuesday") AS عدد_أيام_الثلاثاء,
    GetDaysInfo([shr], 0, "Wednesday") AS عدد_أيام_الأربعاء,
    GetDaysInfo([shr], 0, "Thursday") AS عدد_أيام_الخميس,
    GetDaysInfo([shr], 0, "ج") AS عدد_أيام_الجمعة,
    GetDaysInfo([shr], 0, "السبت") AS عدد_أيام_السبت
FROM data_shr;

المميزات فى الكود

دعم كامل للغات: يقبل المدخلات بالعربية والإنجليزية (كاملة ومختصرة)

كفاءة عالية: تهيئة القواميس مرة واحدة فقط

مرونة استثنائية: يقبل حتى الاختصارات غير التقليدية واقصد بذلك
الأشهر: إضافة اختصارات مثل "ينا" (يناير), "فبر" (فبراير), "ابر" (أبريل), "ديس" (ديسمبر)
الأيام: إضافة اختصارات مثل "ح" (الأحد), "ن" (الإثنين), "جم" (الجمعة)

توثيق ذاتي: يعرض جميع الخيارات المتاحة عند حدوث خطأ

شئ مهم كمان:
ثبات النتائج: تم تثبيت بداية الأسبوع على يوم الأحد باستخدام Weekday(currentDate, vbSunday) لتجنب تأثير إعدادات النظام و لحساب الأيام بشكل دقيق

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

SELECT 
    shr,
    GetDaysInfo(10,0,"MonthDays") AS عدد_أيام_الشهر,
    GetDaysInfo("اكتوبر", 0, "ح") AS 2عدد_أيام_الأحد,
    GetDaysInfo("اكتوبر", 0, "أحد") AS 3عدد_أيام_الأحد,
    GetDaysInfo("اكتوبر", 0, "sun") AS 4عدد_أيام_الأحد,
    GetDaysInfo(10, 0, 1) AS 5عدد_أيام_الأحد
FROM data_shr;

يا اهلاً ومرحباً بصاحب الأفكار الجميلة ،،

عمل جميل جداً ، ولكن انت تعرفني انني أتجنب التوسعات التي قد تُربك صاحب الطلب في إجاباتي 😉 .

مارس 9

4 ساعات مضت, بوكفوس عبدالسلام said:
السلام عليكم ...

داخل الكود هل يتم كتابة جميع الجداول و الإستعلامات و النماذج و التقارير قاعدة البانات:
DoCmd.Close acForm, "اسم_النموذج", acSaveYes
    DoCmd.Close acReport, "اسم_التقرير", acSaveYes
    DoCmd.Close acTable, "اسم_الجدول", acSaveYes
    DoCmd.Close acQuery, "اسم_الاستعلام", acSaveYes

تستطيع الاستغناء عن هذه الأسطر شريطة ان لا يكون هناك نموذج يستدعي أو يشغل أو يستخدم جدولاً من تلك الجداول التي تريد استيرادها 🤗 .

مارس 9

التعديل الصحيح بنظري هو الآتي بإضافة دالة للتعامل مع "أ" أو "إ" أو "ا" أو "ه" أو "ة" :-

Private Function NormalizeArabicText(text As String) As String
    Dim result As String
    result = text
    
    result = Replace(result, "أ", "ا")
    result = Replace(result, "إ", "ا")
    result = Replace(result, "آ", "ا")
    
    result = Replace(result, "ة", "ه")
    
    NormalizeArabicText = result
End Function

Private Function GetLastName(nameArray() As String) As String
    If UBound(nameArray) >= 0 Then
        GetLastName = nameArray(UBound(nameArray))
    Else
        GetLastName = ""
    End If
End Function

Private Sub NameEmployee_AfterUpdate()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim strEmpName As String
    Dim arrName() As String
    Dim lastName As String
    Dim relation As String
    Dim empID As Integer
    Dim found As Boolean
    Dim isFemaleName As Boolean
    Dim i As Integer
    Const MIN_MATCHING_NAMES = 2
    
    Set db = CurrentDb()
    
    strEmpName = Me.NameEmployee
    arrName = Split(strEmpName, " ")
    
    If UBound(arrName) >= 2 Then
        lastName = ""
        For i = 1 To UBound(arrName)
            If i > 1 Then lastName = lastName & " "
            lastName = lastName & arrName(i)
        Next i
    Else
        MsgBox "يجب إدخال الاسم ثلاثيًا على الأقل", vbExclamation + vbMsgBoxRight, "تنبيه"
        Exit Sub
    End If
    
    isFemaleName = (Right(NormalizeArabicText(arrName(0)), 1) = "ه")
    
    Set rs = db.OpenRecordset("SELECT IDeMP, NameEmployee FROM DatEmp WHERE IDeMP <> " & Me.IDeMP)
    
    found = False
    Do While Not rs.EOF
        Dim otherEmpName() As String
        Dim matchingNames As Integer
        
        otherEmpName = Split(rs!NameEmployee, " ")
        
        For i = 0 To UBound(arrName)
            arrName(i) = NormalizeArabicText(arrName(i))
        Next i
        
        For i = 0 To UBound(otherEmpName)
            otherEmpName(i) = NormalizeArabicText(otherEmpName(i))
        Next i
        
        If GetLastName(arrName) = GetLastName(otherEmpName) Then
            If UBound(otherEmpName) >= MIN_MATCHING_NAMES And UBound(arrName) >= MIN_MATCHING_NAMES + 1 Then
                If arrName(1) = otherEmpName(0) Then
                    matchingNames = 1
                    
                    For i = 2 To UBound(arrName)
                        If (i - 1) <= UBound(otherEmpName) Then
                            If arrName(i) = otherEmpName(i - 1) Then
                                matchingNames = matchingNames + 1
                            Else
                                Exit For
                            End If
                        End If
                    Next i
                    
                    If matchingNames > MIN_MATCHING_NAMES Then
                        If isFemaleName Then
                            relation = "ابنة"
                        Else
                            relation = "ابن"
                        End If
                        Me.EntityEmployee = relation
                        Me.NameVerificationEmployee = rs!NameEmployee
                        found = True
                        Exit Do
                    End If
                ElseIf UBound(arrName) >= MIN_MATCHING_NAMES And UBound(otherEmpName) >= MIN_MATCHING_NAMES Then
                    matchingNames = 0
                    
                    For i = 1 To UBound(arrName)
                        If i <= UBound(otherEmpName) Then
                            If arrName(i) = otherEmpName(i) Then
                                matchingNames = matchingNames + 1
                            Else
                                Exit For
                            End If
                        End If
                    Next i
                    
                    If matchingNames > MIN_MATCHING_NAMES Then
                        If isFemaleName Then
                            relation = "أخت"
                        Else
                            relation = "أخ"
                        End If
                        Me.EntityEmployee = relation
                        Me.NameVerificationEmployee = rs!NameEmployee
                        found = True
                        Exit Do
                    End If
                End If
            End If
        End If
        rs.MoveNext
    Loop
    
    If Not found Then
        Me.EntityEmployee = "لا يوجد"
        Me.NameVerificationEmployee = "فردي"
    End If
    
    rs.Close
    Set rs = Nothing
    Set db = Nothing
End Sub

مارس 9

4 دقائق مضت, أمير ادم said:

شكرا لك اخي الكريم

وجعلها لك في ميزان حسناتك

بالفعل هذا هو المطلوب

🌹

انتظر لحظة ، قمت بتجربة الكود على اسماء متنوعة ، والنتيجة غير مرضية بالنسبة لي ,, سأعدل في التالي لاحقاً

مارس 9

59 دقائق مضت, أمير ادم said:

هل من الممكن ان يكون مثل بيانات الجدول هذا

جرب التعديل التالي عله يكون الحل الذي تريده :-

Private Sub NameEmployee_AfterUpdate()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim strEmpName As String
    Dim arrName() As String
    Dim lastName As String
    Dim relation As String
    Dim empID As Integer
    Dim found As Boolean
    Dim isFemaleName As Boolean
    Dim i As Integer
    
    Set db = CurrentDb()
    
    strEmpName = Me.NameEmployee
    arrName = Split(strEmpName, " ")
    
    If UBound(arrName) >= 2 Then
        lastName = ""
        For i = 1 To UBound(arrName)
            If i > 1 Then lastName = lastName & " "
            lastName = lastName & arrName(i)
        Next i
    Else
        MsgBox "يجب إدخال الاسم ثلاثيًا على الأقل", vbExclamation + vbMsgBoxRight, "تنبيه"
        Exit Sub
    End If
    
    isFemaleName = (Right(arrName(0), 1) = "ه" Or Right(arrName(0), 1) = "ة")
    
    Set rs = db.OpenRecordset("SELECT IDeMP, NameEmployee FROM DatEmp WHERE IDeMP <> " & Me.IDeMP)
    
    found = False
    Do While Not rs.EOF
        Dim otherEmpName() As String
        otherEmpName = Split(rs!NameEmployee, " ")
        
        If UBound(otherEmpName) >= 1 Then
            If arrName(1) = otherEmpName(0) Then
                Dim matchFound As Boolean
                matchFound = True
                
                If UBound(arrName) >= 2 And UBound(otherEmpName) >= 2 Then
                    If arrName(2) <> otherEmpName(1) Then
                        matchFound = False
                    End If
                End If
                
                If matchFound Then
                    If isFemaleName Then
                        relation = "ابنة"
                    Else
                        relation = "ابن"
                    End If
                    Me.EntityEmployee = relation
                    Me.NameVerificationEmployee = rs!NameEmployee
                    found = True
                    Exit Do
                End If
            End If
        End If
        rs.MoveNext
    Loop
    
    If Not found Then
        Me.EntityEmployee = "لا يوجد"
        Me.NameVerificationEmployee = "فردي"
    End If
    
    rs.Close
    Set rs = Nothing
    Set db = Nothing
End Sub

مارس 9

5 ساعات مضت, محمد التميمي said:

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

https://www.mediafire.com/file/ss6v518qve9ubgw/New.rar/file

بعد تحميل المرفق من الرابط والإطلاع عليه ،اضطررت الى تعديل أصل الكود بحيث يعمل على النواتين 32 و 64 (النسخة لدي 64 ) ، لتصبح الدالة في المديول كالآتي بعد إزالة التعليقات التوضيحية منها :-

Option Compare Database
Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As LongPtr, ByVal bInheritHandle As LongPtr, ByVal dwProcessId As LongPtr) As LongPtr
    Private Declare PtrSafe Function CloseHandle Lib "kernel32.dll" (ByVal hObject As LongPtr) As Long
    Private Declare PtrSafe Function ExpandEnvironmentStringsW Lib "kernel32.dll" (ByVal lpSrc As LongPtr, Optional ByVal lpDst As LongPtr, Optional ByVal nSize As LongPtr) As Long
    Private Declare PtrSafe Function GetExitCodeProcess Lib "kernel32.dll" (ByVal hProcess As LongPtr, ByRef lpExitCode As Long) As Long
    Private Declare PtrSafe Function MsgWaitForMultipleObjects Lib "user32.dll" (ByVal nCount As Long, ByRef pHandles As LongPtr, ByVal bWaitAll As Long, ByVal dwMilliseconds As Long, ByVal dwWakeMask As Long) As Long
    Private Declare PtrSafe Function SysReAllocStringLen Lib "oleaut32.dll" (ByVal pBSTR As LongPtr, Optional ByVal pszStrPtr As LongPtr, Optional ByVal Length As Long) As Long
    Private Declare PtrSafe Function CreateWaitableTimerW Lib "kernel32.dll" (Optional ByVal lpTimerAttributes As LongPtr, Optional ByVal bManualReset As Long, Optional ByVal lpTimerName As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetProcessId Lib "kernel32.dll" (ByVal hProcess As LongPtr) As Long
    Private Declare PtrSafe Function PathCanonicalizeW Lib "shlwapi.dll" (ByVal lpszDst As LongPtr, ByVal lpszSrc As LongPtr) As Long
    Private Declare PtrSafe Function PathGetArgsW Lib "shlwapi.dll" (ByVal pszPath As LongPtr) As LongPtr
    Private Declare PtrSafe Function SetWaitableTimer Lib "kernel32.dll" (ByVal hTimer As LongPtr, ByRef pDueTime As Currency, Optional ByVal lPeriod As Long, Optional ByVal pfnCompletionRoutine As LongPtr, Optional ByVal lpArgToCompletionRoutine As LongPtr, Optional ByVal fResume As Long) As Long
    Private Declare PtrSafe Function ShellExecuteExW Lib "shell32.dll" (ByVal pExecInfo As LongPtr) As Long
    Private Declare PtrSafe Function SysReAllocString Lib "oleaut32.dll" (ByVal pBSTR As LongPtr, Optional ByVal pszStrPtr As LongPtr) As Long
    Private Declare PtrSafe Sub PathRemoveArgsW Lib "shlwapi.dll" (ByVal pszPath As LongPtr)
#Else
    Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
    Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
    Private Declare Function ExpandEnvironmentStringsW Lib "kernel32.dll" (ByVal lpSrc As Long, Optional ByVal lpDst As Long, Optional ByVal nSize As Long) As Long
    Private Declare Function GetExitCodeProcess Lib "kernel32.dll" (ByVal hProcess As Long, ByRef lpExitCode As Long) As Long
    Private Declare Function MsgWaitForMultipleObjects Lib "user32.dll" (ByVal nCount As Long, ByRef pHandles As Long, ByVal bWaitAll As Long, ByVal dwMilliseconds As Long, ByVal dwWakeMask As Long) As Long
    Private Declare Function SysReAllocStringLen Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long, Optional ByVal Length As Long) As Long
    Private Declare Function CreateWaitableTimerW Lib "kernel32.dll" (Optional ByVal lpTimerAttributes As Long, Optional ByVal bManualReset As Long, Optional ByVal lpTimerName As Long) As Long
    Private Declare Function GetProcessId Lib "kernel32.dll" (ByVal hProcess As Long) As Long
    Private Declare Function PathCanonicalizeW Lib "shlwapi.dll" (ByVal lpszDst As Long, ByVal lpszSrc As Long) As Long
    Private Declare Function PathGetArgsW Lib "shlwapi.dll" (ByVal pszPath As Long) As Long
    Private Declare Function SetWaitableTimer Lib "kernel32.dll" (ByVal hTimer As Long, ByRef pDueTime As Currency, Optional ByVal lPeriod As Long, Optional ByVal pfnCompletionRoutine As Long, Optional ByVal lpArgToCompletionRoutine As Long, Optional ByVal fResume As Long) As Long
    Private Declare Function ShellExecuteExW Lib "shell32.dll" (ByVal pExecInfo As Long) As Long
    Private Declare Function SysReAllocString Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long) As Long
    Private Declare Sub PathRemoveArgsW Lib "shlwapi.dll" (ByVal pszPath As Long)
#End If

Private Const SEE_MASK_NOCLOSEPROCESS As Long = &H40
Private Const SEE_MASK_DOENVSUBST As Long = &H200
Private Const SEE_MASK_FLAG_NO_UI As Long = &H400

#If VBA7 Then
    Private Type SHELLEXECUTEINFO
        cbSize As Long
        fMask As Long
        hWnd As LongPtr
        lpVerb As String
        lpFile As String
        lpParameters As String
        lpDirectory As String
        nShow As Long
        hInstApp As LongPtr
        lpIDList As LongPtr
        lpClass As String
        hkeyClass As LongPtr
        dwHotKey As Long
        hIcon As LongPtr
        hProcess As LongPtr
    End Type
#Else
    Private Type SHELLEXECUTEINFO
        cbSize As Long
        fMask As Long
        hWnd As Long
        lpVerb As String
        lpFile As String
        lpParameters As String
        lpDirectory As String
        nShow As Long
        hInstApp As Long
        lpIDList As Long
        lpClass As String
        hkeyClass As Long
        dwHotKey As Long
        hIcon As Long
        hProcess As Long
    End Type
#End If

Public Const INFINITE As Long = &HFFFFFFFF
Public Const STILL_ACTIVE As Long = &H103
Public Const PROCESS_HAS_TERMINATED As Long = vbObjectError Or &HDEAD

Public Enum AppWinStyle
    vbHide = 0
    vbShowNormal = 1
    vbShowMinimized = 2
    vbShowMaximized = 3
    vbMaximize = 3
    vbShowNoActivate = 4
    vbShow = 5
    vbMinimize = 6
    vbShowMinNoActive = 7
    vbShowNA = 8
    vbRestore = 9
    vbShowDefault = 10
End Enum

Public Function Shell_n_Wait(ByRef PathName As String, Optional ByVal WindowStyle As VbAppWinStyle = vbNormalFocus) As Long
    Const PROCESS_QUERY_INFORMATION = &H400, QS_ALLINPUT = &H4FF, SYNCHRONIZE = &H100000
    Dim hProcess As LongPtr, sPath As String

    If InStr(PathName, "%") = 0 Then
        sPath = PathName
    Else
        SysReAllocStringLen VarPtr(sPath), , ExpandEnvironmentStringsW(StrPtr(PathName)) - 1
        ExpandEnvironmentStringsW StrPtr(PathName), StrPtr(sPath), Len(sPath) + 1
    End If

    On Error GoTo ErrorHandler
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or SYNCHRONIZE, False, Shell(sPath, WindowStyle))
    On Error GoTo 0

    If hProcess Then
        sPath = vbNullString
        Do While MsgWaitForMultipleObjects(1, hProcess, False, INFINITE, QS_ALLINPUT)
            DoEvents
        Loop
        GetExitCodeProcess hProcess, Shell_n_Wait
        CloseHandle hProcess
    End If

    Exit Function

ErrorHandler:
    Err.Raise Err.Number, , Err.Description
End Function

Public Function ShellW(ByRef PathName As String, Optional ByVal WindowStyle As AppWinStyle = vbShowNormal, Optional ByVal Wait As Long) As Long
    Const MAX_PATH = 260, QS_ALLINPUT = &H4FF, WAIT_OBJECT_0 = &H0
    Dim TimedOut As Boolean, nCount As Long, pHandles As LongPtr, RV As Long, SEI As SHELLEXECUTEINFO

    Err.Clear
    If LenB(PathName) = 0 Then Exit Function

    With SEI
        .cbSize = LenB(SEI)
        .fMask = SEE_MASK_NOCLOSEPROCESS Or SEE_MASK_DOENVSUBST Or SEE_MASK_FLAG_NO_UI
        .nShow = WindowStyle

        If InStr(PathName, "%") Then
            SysReAllocStringLen VarPtr(.lpFile), , ExpandEnvironmentStringsW(StrPtr(PathName)) - 1
            ExpandEnvironmentStringsW StrPtr(PathName), StrPtr(.lpFile), Len(.lpFile) + 1
        Else
            .lpFile = PathName
        End If

        If InStr(.lpFile, "\.") <> 0 Or InStr(.lpFile, ".\") <> 0 Then
            If Len(.lpFile) < MAX_PATH Then
                SysReAllocStringLen VarPtr(.lpVerb), , MAX_PATH - 1
                If PathCanonicalizeW(StrPtr(.lpVerb), StrPtr(.lpFile)) Then
                    SysReAllocString VarPtr(.lpFile), StrPtr(.lpVerb)
                End If
                .lpVerb = vbNullString
            End If
        End If

        SysReAllocString VarPtr(.lpParameters), PathGetArgsW(StrPtr(.lpFile))
        If LenB(.lpParameters) Then
            PathRemoveArgsW StrPtr(.lpFile)
            If InStr(.lpParameters, """") Then .lpParameters = Replace(.lpParameters, """", """""")
        End If

        If ShellExecuteExW(VarPtr(SEI)) Then
            ShellW = GetProcessId(.hProcess)

            If Wait Then
                .lpFile = vbNullString
                .lpParameters = vbNullString

                If .hProcess Then
                    nCount = 1
                    pHandles = VarPtr(.hProcess)
                End If

                If Wait > INFINITE Then
                    .hIcon = CreateWaitableTimerW
                    If .hIcon Then
                        nCount = nCount + 1
                        pHandles = VarPtr(.hIcon)
                        Wait = SetWaitableTimer(.hIcon, CCur(-Wait))
                    End If
                End If

                Do
                    RV = MsgWaitForMultipleObjects(nCount, ByVal pHandles, False, INFINITE, QS_ALLINPUT)
                    If RV < nCount Then
                        If .hIcon Then
                            TimedOut = RV = 0
                            RV = CloseHandle(.hIcon)
                        End If
                        Err.Clear
                        Exit Do
                    End If
                    DoEvents
                Loop

                If Not (TimedOut) Then
                    RV = GetExitCodeProcess(.hProcess, ShellW)
                    Err = PROCESS_HAS_TERMINATED
                    Err.Description = "Exit Code"
                End If
            End If

            If .hProcess Then RV = CloseHandle(.hProcess)
        End If
    End With
End Function

Public Function ShellWS(ByRef Command As String, Optional ByVal WindowStyle As VbAppWinStyle = vbNormalFocus, Optional ByVal WaitOnReturn As Boolean) As Long
    Dim ws As Object
    Set ws = CreateObject("Wscript.Shell")
    ShellWS = ws.Run(Command, WindowStyle, WaitOnReturn)
End Function

الآن في النموذج الأول th44 ، وبعد نسخ مربع النص str_Text وعنصر الصورة للباركود اليه ، أصبح كود النموذج كالآتي :-

Option Compare Database
Option Explicit

Private Function ConstQRPath()
    ConstQRPath = CurrentProject.Path & "\Data\QR_images\" & Me.Key & " - " & "QR_code.png"
End Function

Private Function ConstBarcodePath()
    ConstBarcodePath = CurrentProject.Path & "\Data\QR_images\" & Me.Key & " - " & "ID_PDF_417.png"
End Function

Private Sub CreateQRCode()
    On Error GoTo ErrorHandler
    
    If IsNull(Me.th_Text) Or IsEmpty(Me.th_Text) Or Len(Trim(Nz(Me.th_Text, ""))) = 0 Then
        Exit Sub
    End If
    
    Dim AppName As String
    Dim OutputFile As String
    Dim OutputText As String
    Dim CommandLine As String
    
    AppName = Chr(34) & Application.CurrentProject.Path & "\Data\zint.exe" & Chr(34)
    OutputText = Chr(34) & Me.th_Text & Chr(34)
    OutputFile = Chr(34) & ConstQRPath & Chr(34)
    
    CommandLine = AppName & " -o " & OutputFile & " --rotate=0 --eci=24 --scale=2 -w 0 --height=100 --barcode=58 -d " & OutputText
    Shell_n_Wait CommandLine, vbHide
    Exit Sub
ErrorHandler:
    MsgBox "An error occurred: " & Err.Description, vbCritical, "Error"
End Sub

Private Sub CreateBarcode()
    On Error GoTo ErrorHandler
    
    If IsNull(Me.str_Text) Or IsEmpty(Me.str_Text) Or Len(Trim(Nz(Me.str_Text, ""))) = 0 Then
        Exit Sub
    End If
    
    Dim AppName As String
    Dim OutputFile As String
    Dim OutputText As String
    Dim CommandLine As String
    
    AppName = Chr(34) & Application.CurrentProject.Path & "\Data\zint.exe" & Chr(34)
    OutputText = Chr(34) & Me.str_Text & Chr(34)
    OutputFile = Chr(34) & ConstBarcodePath & Chr(34)
    
    CommandLine = AppName & " -o " & OutputFile & " --rotate=0 --eci=24 --binary --barcode=55 --mode=3 -d " & OutputText
    
    Shell_n_Wait CommandLine, vbHide
    Exit Sub
ErrorHandler:
    MsgBox "An error occurred: " & Err.Description, vbCritical, "Error"
End Sub

Private Sub Form_Current()
    Call CreateAndDisplayCodes
End Sub

Sub CreateAndDisplayCodes()
    On Error GoTo ErrorHandler

    If IsNull(Me.th_Text) Or IsEmpty(Me.th_Text) Or Len(Trim(Nz(Me.th_Text, ""))) = 0 Then
        Me.QR_Code.Picture = ""
    Else
        Call CreateQRCode
        Me.QR_Code.Picture = ConstQRPath
    End If

    If IsNull(Me.str_Text) Or IsEmpty(Me.str_Text) Or Len(Trim(Nz(Me.str_Text, ""))) = 0 Then
        Me.ID_PDF_417.Picture = ""
    Else
        Call CreateBarcode
        Me.ID_PDF_417.Picture = ConstBarcodePath
    End If

    Exit Sub

ErrorHandler:
    If Err.Number = 2220 Then
        Me.QR_Code.Picture = ""
        Me.ID_PDF_417.Picture = ""
    Else
        MsgBox "An unexpected error occurred: " & Err.Description, vbCritical, "Code generation error"
    End If
    Resume Next
End Sub

Private Sub sdfff_Click()
    On Error Resume Next
    DoCmd.OpenForm "thaaer55"
    Dim RName, FldCriteria As String
    RName = "rpt_Details"
    FldCriteria = "[Key]=" & Me![Key]
    DoCmd.OpenReport RName, acViewNormal, , FldCriteria
End Sub

وهذا الملف بعد التعديل :-

New.zip

اخبرنا بالنتيجة 😊 .

مارس 8

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

من خلال تصميمك للجدول ، نستطيع انشاء دالة عامة في مديول كالتالي - بناءً على أسماء الأشهر لديك :-

Function CalculateFridaysSaturdays(monthName As String, year As Integer, Optional dayType As String = "Both") As Variant
    Dim monthNumber As Integer
    Dim startDate As Date
    Dim endDate As Date
    Dim currentDate As Date
    Dim fridays As Integer
    Dim saturdays As Integer
    
    Select Case monthName
        Case "يناير"
            monthNumber = 1
        Case "فبراير"
            monthNumber = 2
        Case "مارس"
            monthNumber = 3
        Case "ابريل"
            monthNumber = 4
        Case "مايو"
            monthNumber = 5
        Case "يونيو"
            monthNumber = 6
        Case "يوليو"
            monthNumber = 7
        Case "اغسطس"
            monthNumber = 8
        Case "سبتمبر"
            monthNumber = 9
        Case "اكتوبر"
            monthNumber = 10
        Case "نوفمبر"
            monthNumber = 11
        Case "ديسمبر"
            monthNumber = 12
        Case Else
            CalculateFridaysSaturdays = "اسم الشهر غير صحيح"
            Exit Function
    End Select
    
    startDate = DateSerial(year, monthNumber, 1)
    endDate = DateSerial(year, monthNumber + 1, 0)
    
    fridays = 0
    saturdays = 0
    currentDate = startDate
    
    Do While currentDate <= endDate
        If Weekday(currentDate) = vbFriday Then
            fridays = fridays + 1
        ElseIf Weekday(currentDate) = vbSaturday Then
            saturdays = saturdays + 1
        End If
        currentDate = currentDate + 1
    Loop
    
    If dayType = "Friday" Then
        CalculateFridaysSaturdays = fridays
    ElseIf dayType = "Saturday" Then
        CalculateFridaysSaturdays = saturdays
    Else
        CalculateFridaysSaturdays = Array(fridays, saturdays)
    End If
End Function

ومن خلال استعلام تحديث ، تستطيع استدعاء الدالة لتحديث القيم في الحقلين حسب السنة الحالية كالآتي :-

UPDATE data_shr SET gm = CalculateFridaysSaturdays([shr], Year(Date()), "Friday"), sbt = CalculateFridaysSaturdays([shr], Year(Date()), "Saturday");

النتيجة ، افتح استعلام التحديث Query2 وشوف النتيجة في المرفق التالي :-

ايام الغياب.accdb

مارس 8

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

قم بإضافة زر إلى نموذج (مثلاً : btnRestore)

اجعل الكود التالي كتجربة ( بما انك لم تقم بارفاق قاعدتا البيانات للتجربة ) فيحدث عند النقر للزر السابق :-

Private Sub btnRestore_Click()
    Dim dbPath As String
    Dim backupPath As String
    Dim fso As Object
    Dim fd As FileDialog
    
    dbPath = CurrentProject.FullName
    
    Set fd = Application.FileDialog(3)
    
    With fd
        .Title = "اختر ملف النسخة الاحتياطية"
        .Filters.Clear
        .Filters.Add "ملفات Access", "*.accdb;*.mdb"
        .AllowMultiSelect = False
        
        If .Show = -1 Then
            backupPath = .SelectedItems(1)
        Else
            MsgBox "لم يتم تحديد أي ملف!", vbExclamation + vbMsgBoxRight, "إلغاء العملية"
            Exit Sub
        End If
    End With
    
    If Dir(backupPath) = "" Then
        MsgBox "الملف المحدد غير موجود", vbExclamation + vbMsgBoxRight, "خطأ"
        Exit Sub
    End If
    
    DoCmd.Close acForm, "اسم_النموذج", acSaveYes
    DoCmd.Close acReport, "اسم_التقرير", acSaveYes
    DoCmd.Close acTable, "اسم_الجدول", acSaveYes
    DoCmd.Close acQuery, "اسم_الاستعلام", acSaveYes
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    fso.DeleteFile dbPath, True
    fso.CopyFile backupPath, dbPath
    
    MsgBox "تم استعادة النسخة الاحتياطية بنجاح ! قد تحتاج إعادة تشغيل البرنامج", vbInformation + vbMsgBoxRight, "نجاح"
    
End Sub

يجب توافر المكتبة Microsoft Office XX.0 Object Library

مارس 8

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

جرب هذا التعديل بالاستعلام التالي :-

SELECT D.Cood, 
       IIf([D].[Percent]*100 <= 60 Or [S].[natio] = 'S', "خارج", [S].[Tans]) AS Expr1
FROM S 
INNER JOIN D ON S.Cood = D.Cood;

جرب الاستعلام وأخبرني بالنتيجة !! 😊

مارس 8

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

جرب فكرتي البسيطة ..

Private Sub NameEmployee_AfterUpdate()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim strEmpName As String
    Dim arrName() As String
    Dim lastName As String
    Dim relation As String
    Dim empID As Integer
    Dim found As Boolean
    
    Set db = CurrentDb()
    
    strEmpName = Me.NameEmployee
    
    arrName = Split(strEmpName, " ")
    
    If UBound(arrName) >= 2 Then
        lastName = arrName(UBound(arrName))
    Else
        MsgBox "يجب إدخال الاسم ثلاثيًا على الأقل.", vbExclamation, "تنبيه"
        Exit Sub
    End If
    
    Set rs = db.OpenRecordset("SELECT IDeMP, NameEmployee FROM DatEmp WHERE NameEmployee Like '*" & lastName & "' AND IDeMP <> " & Me.IDeMP)
    
    found = False
    Do While Not rs.EOF
        If InStr(rs!NameEmployee, lastName) > 0 Then
            If InStr(rs!NameEmployee, arrName(0)) > 0 Then
                relation = "ابن"
            ElseIf InStr(rs!NameEmployee, arrName(1)) > 0 Then
                relation = "أخ"
            Else
                relation = "أخت"
            End If
            
            Me.EntityEmployee = relation
            Me.NameVerificationEmployee = rs!NameEmployee
            found = True
            Exit Do
        End If
        rs.MoveNext
    Loop
    
    If Not found Then
        Me.EntityEmployee = ""
        Me.NameVerificationEmployee = ""
    End If
    
    rs.Close
    Set rs = Nothing
    Set db = Nothing
End Sub

emp.7z

مارس 8

لم اقم بتحميل المرفق ، ولكن جرب التالي بتصحيح بعض الأخطاء ..

Private Sub txt_AfterUpdate()
    Dim selectedYear As Integer
    If IsNumeric(Me.txt.Value) Then
        selectedYear = CInt(Me.txt.Value)
    Else
        MsgBox "الرجاء إدخال سنة صحيحة", vbExclamation
        Exit Sub
    End If
    Me.Filter = "[totalshy] = 0 OR ([yearshy] <> " & selectedYear & " AND [totalshy] <> 0)"
    Me.FilterOn = True
End Sub

مارس 8

12 ساعات مضت, محمد التميمي said:

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

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

New.rar 295.06 kB · 9 downloads

نفس النتيجة للأسف ، يبدو أن جهازك مصاب بفايروس لذلك لا تظهر المشكلة في جهازك يا صديقي 🤗,

مارس 8

عمل جميل جداً ، وجزاك الله كل خير على مجهودك ..

وتقبل الله طاعاتكم وصيامكم وقيامكم ،، وهنأكم بإفطاركم بهذا الشهر الفضيل ..

لي مداخلة بسيطة وهي أن معظم ( 90% ) من مصممي البرامج يتوجهون الى ان تكون الرسائل باللغة العربية ؛

على الأقل ليسهل فهمها للمستخدم وللوصول الى حل المشكلة التي ظهرت له :excl: .

هل يمكن تنفيذ الفكرة ???

مارس 8

20 دقائق مضت, محمد التميمي said:

السلام عليكم :

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

المرفق غير سليم ، :excl: ،

Trojan.png.288a41aef6a12fe6fda7e6eb6189ea23.png

مارس 7

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

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

- على العموم استخدم الكود في حدث عند التحميل للنموذج ، وسيبقى مفعلاً لكل الأكواد الأخرى داخل النموذج طالما لم يتم تغييره في أي إجراء آخر .
- أولاً لم أقم بتجربتها ، جرب استعماله في حدث On Error للنموذج كإجراء عام .

مارس 7

4 ساعات مضت, أبو صفاء وأحمد said:

لكن فكرة الجدول الواحد هذه ستجعل من المستخدم يكرر نفس بيانات السيارات أو العملاء في كل مرة، لأن السيارة الواحدة يمكن أن تتأجر في شهر واحد 4 مرات ومن عملاء مختلفين، وأن العميل الواحد يمكن أن يؤجر سيارات متعددة وفي اوقات مختلفة.

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

يبدو انني لم أقم بتوصيل المعلومة جيداً..

جدول العملاء والسيارات لا غنى عنهم ( ولا اختلاف في ذلك ).

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

مارس 6

مشاركة مع الإخوة والأساتذة ، جرب استعلام التوحيد Query1 التالي :-

SELECT tip.ID, tip.nam, '2024' AS MissedYear
FROM tip
WHERE tip.ID NOT IN (SELECT Tshy.id FROM Tshy WHERE Tshy.yearshy = '2024')
UNION
SELECT tip.ID, tip.nam, '2025' AS MissedYear
FROM tip
WHERE tip.ID NOT IN (SELECT Tshy.id FROM Tshy WHERE Tshy.yearshy = '2025');

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

test.accdb

مارس 6

17 دقائق مضت, طاهر اوفيسنا said:

اخي حسب الجدول فإن السجلات التي أشرت لها لا علاقة لها بالدفع خلال السنوات المعنية 2024-2025

ملاحظة : في نظري فيه نقص في ملء سجل البيانات

هذا يعني أن السجل 1 ، دفع في 2024,2025 على سبيل المثال ، صحيح ؟؟؟؟

أعتقد ان طريقة بنية الجدول والسجلات ستربك لاحقاً الاستعلام عند كثرة السجلات وزيادة البيانات 😵 !!!!

مارس 6

مشاركة مع أخي الأستاذ @ناقل ، هذه مشاركتي بحيث لو كانت المسافات بداية أو نهاية النص ، وليس فقط بداية النص :-

Me.FADD = Trim(Me.FADD)

مارس 6

منذ ساعه, moho58 said:

من خلال مداخلتكم الأساتذة الكرام :

نفهم ان خاصية إعادة تحجيم الورقة أو تصغيره غير موجودة في الأكسيس

بينما موجودة في الإكسيل

تشكراتي الخالصة على اهتمامكم وتفاعلكم مع موضوعي

وباعتقادي ان الحل المقترح من الأستاذ @Moosak ، هو الأنسب لك ولمشكلتك ، بغض النظر عن اتجاه النص ( لا اعتقد انه يمثل مشكلة كبيرة ) الا اذا اردت الإستغناء عن مربعات النص بصورة لكل حقل بحيث تكتب صورة وترفقها في التقرير بدلاً من المربع النصي !!!

مارس 5

37 دقائق مضت, طاهر اوفيسنا said:

عفوا على المداخلة اساتذة في الورد كنت نقوم بطباعة ورق حجم A3 بحجم A4 دون إعادة تنسيق وتظبيط تنسيق التقرير وتصغير الحقول والخطوط لتلائم حجم ال A4 كما اشار إليها الاستاذ Moosak بخاصية في الطابعة ونفس الشيء تطبق على الاكسس

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

مارس 5

11 دقائق مضت, Eng.Qassim said:

😂 لم تغب عن بالي ...فعلتها لكنها لم تضبط معي

وها انت قد حصلت عليها 😉

مارس 5

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

بدون الحاجة لأي تدخل برمجي أعتقد أنه بإمكانك إعادة تنسيق وتظبيط تنسيق التقرير وتضغير الحقول والخطوط لتلائم حجم ال A4 مباشرة 🙂

🔆 فكرة لامعة وجميلة فعلاً ، وتخيل انها غابت عن بال من مر من هنا وأولهم العبد الفقير الى الله

تسجيل الدخول

التقويم

المنتدى

مكتبة الموقع

معرض الصور

المدونات

الوسائط المتعددة

مشاركات المكتوبه بواسطه Foksh

Important Information