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

Private Sub Form_Timer()
    ' زيادة العداد
    x = x + 1
    
    ' تحديث الوقت الحالي في Text1
    Me.Text1 = Time
    
    ' تغيير المنطقة الزمنية كل 5 ثواني
    If x = 5 Then
        x = 0
        currentTimeZone = currentTimeZone + 1
        
        ' إعادة تعيين المنطقة الزمنية إذا تجاوزت الحد الأقصى
        If currentTimeZone > 10 Then currentTimeZone = 0
        
        ' الحصول على التوقيت العالمي (UTC) بطرح 3 ساعات من التوقيت المحلي (مكة المكرمة)
        Dim utcTime As Date
        utcTime = DateAdd("h", -3, Time)
        
        ' الحصول على الوقت حسب المنطقة الزمنية الحالية
        Select Case currentTimeZone
            Case 0  ' أبوظبي (UTC+4)
                Me.Text2 = Format(DateAdd("h", 4, utcTime), "hh:nn:ss AM/PM") & " أبوظبي"
            Case 1  ' مكة المكرمة (UTC+3)
                Me.Text2 = Format(DateAdd("h", 3, utcTime), "hh:nn:ss AM/PM") & " مكة المكرمة"
            Case 2  ' توقيت غرينتش (UTC+0)
                Me.Text2 = Format(utcTime, "hh:nn:ss AM/PM") & " غرينتش"
            Case 3  ' موسكو (UTC+3)
                Me.Text2 = Format(DateAdd("h", 3, utcTime), "hh:nn:ss AM/PM") & " موسكو"
            Case 4  ' نيويورك (UTC-5)
                Me.Text2 = Format(DateAdd("h", -5, utcTime), "hh:nn:ss AM/PM") & " نيويورك"
            Case 5  ' طوكيو (UTC+9)
                Me.Text2 = Format(DateAdd("h", 9, utcTime), "hh:nn:ss AM/PM") & " طوكيو"
            Case 6  ' عدن (UTC+3)
                Me.Text2 = Format(DateAdd("h", 3, utcTime), "hh:nn:ss AM/PM") & " عدن"
            Case 7  ' القاهرة (UTC+2)
                Me.Text2 = Format(DateAdd("h", 2, utcTime), "hh:nn:ss AM/PM") & " القاهرة"
            Case 8  ' بكين (UTC+8)
                Me.Text2 = Format(DateAdd("h", 8, utcTime), "hh:nn:ss AM/PM") & " بكين"
            Case 9  ' باريس (UTC+1)
                Me.Text2 = Format(DateAdd("h", 1, utcTime), "hh:nn:ss AM/PM") & " باريس"
            Case 10 ' لندن (UTC+0)
                Me.Text2 = Format(utcTime, "hh:nn:ss AM/PM") & " لندن"
        End Select
    End If
End Sub

هناك خطأ في جزء تنسيق حقل الاستقالة (BD)، حيث يتم تغيير خلفية الحقل الخاطئ:

Option Compare Database
Option Explicit

Private x As Integer
Private currentTimeZone As Integer

Private Sub Form_Timer()
    ' زيادة العداد وتحديث الوقت
    x = x + 1
    Me.Text1 = Time
    
    ' تحديث المناطق الزمنية
    UpdateTimeZones
    
    ' تحديث تنسيق الحقول
    UpdateFieldFormats
End Sub

Private Sub UpdateTimeZones()
    ' تغيير المنطقة الزمنية كل 5 ثواني
    If x = 5 Then
        x = 0
        currentTimeZone = currentTimeZone + 1
        If currentTimeZone > 3 Then currentTimeZone = 0
        
        ' الحصول على الوقت حسب المنطقة الزمنية الحالية
        Select Case currentTimeZone
            Case 0  ' أبوظبي (UTC+4)
                Me.Text2 = Format(DateAdd("h", 4, TimeSerial(Hour(Time), Minute(Time), Second(Time))), "hh:nn:ss") & " أبوظبي"
            Case 1  ' مكة المكرمة (UTC+3)
                Me.Text2 = Format(DateAdd("h", 3, TimeSerial(Hour(Time), Minute(Time), Second(Time))), "hh:nn:ss") & " مكة المكرمة"
            Case 2  ' توقيت غرينتش (UTC+0)
                Me.Text2 = Format(TimeSerial(Hour(Time), Minute(Time), Second(Time)), "hh:nn:ss") & " غرينتش"
            Case 3  ' موسكو (UTC+3)
                Me.Text2 = Format(DateAdd("h", 3, TimeSerial(Hour(Time), Minute(Time), Second(Time))), "hh:nn:ss") & " موسكو"
        End Select
    End If
End Sub

Private Sub UpdateFieldFormats()
    On Error Resume Next
    
    ' تنسيق حقل بدل فاقد
    If [TT] = "بدل فاقد" Then
        If [TT].ForeColor = vbYellow Then
            [TT].ForeColor = vbBlack
            [TT].BackColor = vbBlack
        Else
            [TT].ForeColor = vbYellow
            [TT].BackColor = vbBlack
        End If
    Else
        [TT].ForeColor = vbBlack
        [TT].BackColor = vbWhite
    End If
    
    ' تنسيق حقل متقاعد
    If [ss] = "متقاعد" Then
        If [ss].ForeColor = vbWhite Then
            [ss].ForeColor = vbBlue
            [ss].BackColor = vbRed
        Else
            [ss].ForeColor = vbWhite
            [ss].BackColor = vbBlue
        End If
    Else
        [ss].ForeColor = vbBlack
        [ss].BackColor = vbYellow
    End If
    
    ' تنسيق حقل استقالة
    If [BD] = "استقالة" Then
        If [BD].ForeColor = vbWhite Then
            [BD].ForeColor = vbRed
            [BD].BackColor = vbRed  ' تم التصحيح: تغيير خلفية BD بدلاً من ss
        Else
            [BD].ForeColor = vbWhite
            [BD].BackColor = vbRed
        End If
    Else
        [BD].ForeColor = vbBlack
        [BD].BackColor = vbYellow
    End If
End Sub

وإن لم يعمل ارفق ملف المشروع فقط بالاكواد التي يوجد بها مشكلة

استبدل الكود

Option Compare Database

Private Sub Command5_Click()
    CalculateBMI
End Sub

Private Sub CalculateBMI()
    If IsNumeric(w2.Value) And IsNumeric(w1.Value) Then
        Dim weight As Double
        Dim height As Double
        Dim bmi As Double
        
        weight = CDbl(w2.Value)    ' الوزن بالكيلوغرام
        height = CDbl(w1.Value)    ' الطول بالمتر
        
        ' تأكد من أن الطول بالمتر وليس بالسنتيمتر
        If height > 3 Then
            height = height / 100  ' تحويل من سنتيمتر إلى متر
        End If
        
        ' حساب مؤشر كتلة الجسم
        bmi = weight / (height * height)
        
        ' عرض النتيجة برقمين عشريين
        w3.Value = Format(bmi, "0.00")
        
        ' تحديد الفئة حسب مؤشر كتلة الجسم
        If bmi < 16.5 Then
            Me.ww = "نقص حاد بالوزن"
        ElseIf bmi >= 16.5 And bmi < 18.5 Then
            Me.ww = "نقص بالوزن"
        ElseIf bmi >= 18.5 And bmi < 25 Then
            Me.ww = "وزن مثالي"
        ElseIf bmi >= 25 And bmi < 30 Then
            Me.ww = "زيادة في الوزن"
        ElseIf bmi >= 30 And bmi < 35 Then
            Me.ww = "بداية سمنة"
        Else
            Me.ww = "سمنة مفرطة"
        End If
        
        ' إظهار النتائج
        ww.Visible = True
        w3.Visible = True
    Else
        MsgBox "الرجاء إدخال قيم صحيحة للطول والوزن", vbExclamation
    End If
End Sub

test.accdb

استخدم Val() إذا كنت غير متأكد من نوع البيانات المدخلة

استخدم CLng() إذا كنت متأكداً أن المدخلات ستكون أرقاماً صحيحة فقط

الطريقة الاولي

DoCmd.OpenForm "Fnet", , , "NET=" & Val(asknet), acFormReadOnly

الطريقة الثانية

DoCmd.OpenForm "Fnet", , , "NET=" & CLng(asknet), acFormReadOnly

اقتباس

حلو ه الفكره 
ولكن كيف فتح عدد 2 محرر اكود لنفس الحدث

لاني اريد كود الوقت لبعض الدول مثل
ابوظبي

مكة

قرينتش

موسكو
في حقل واحد وتتغير كل 5 ثواني بين كل دوله في التوقيت

Option Compare Database
Option Explicit

Private x As Integer
Private currentTimeZone As Integer

Private Sub Form_Timer()
    ' زيادة العداد
    x = x + 1
    
    ' تحديث الوقت الحالي في Text1
    Me.Text1 = Time
    
    ' تغيير المنطقة الزمنية كل 5 ثواني
    If x = 5 Then
        x = 0
        currentTimeZone = currentTimeZone + 1
        If currentTimeZone > 3 Then currentTimeZone = 0
        
        ' الحصول على الوقت حسب المنطقة الزمنية الحالية
        Select Case currentTimeZone
            Case 0  ' أبوظبي (UTC+4)
                Me.Text2 = Format(DateAdd("h", 4, TimeSerial(Hour(Time), Minute(Time), Second(Time))), "hh:nn:ss") & " أبوظبي"
            Case 1  ' مكة المكرمة (UTC+3)
                Me.Text2 = Format(DateAdd("h", 3, TimeSerial(Hour(Time), Minute(Time), Second(Time))), "hh:nn:ss") & " مكة المكرمة"
            Case 2  ' توقيت غرينتش (UTC+0)
                Me.Text2 = Format(TimeSerial(Hour(Time), Minute(Time), Second(Time)), "hh:nn:ss") & " غرينتش"
            Case 3  ' موسكو (UTC+3)
                Me.Text2 = Format(DateAdd("h", 3, TimeSerial(Hour(Time), Minute(Time), Second(Time))), "hh:nn:ss") & " موسكو"
        End Select
    End If
End Sub

تأكد من وجود مؤقت (Timer) في النموذج

اضبط فترة المؤقت على 1000 (ثانية واحدة)

أضف مربعي نص Text1 و Text2

سيعرض Text1 الوقت المحلي

سيعرض Text2 الأوقات المتغيرة للمدن المختلفة

---------------------------------------------------------

x: عداد للثواني

currentTimeZone: متغير لتتبع المنطقة الزمنية الحالية

2 Events - edit.accdb

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

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

نظرة عامة:

• قواعد البيانات بصيغة Accde أو Mde:
  هذه الصيغ محمية بشكل قوي، وبالتالي لا يُنصح بالبحث عن طرق لفك الحماية.

• قواعد البيانات بصيغة Accdb أو Mdb:
  في حالة العمل مع هذه الصيغ، هناك خيارات شرعية، مثل:

  1. إنشاء قاعدة بيانات جديدة:
     يمكنك استيراد المكونات مع مراعاة وجود كلمة المرور.
  2. ضرورة احترام حقوق المبرمجين:
     من المهم دائمًا احترم عمل الآخرين وعدم انتهاك حقوق الملكية الفكرية.

نحن هنا لتقديم المساعدة والإرشادات، لكن من المهم أن نكون واعين للأثر الذي قد تحدثه أفعالنا على الآخرين في هذا المجال.

ختامًا:
إذا كانت لديك استفسارات أو تحتاج إلى مساعدة في جوانب أخرى ضمن البرمجة أو قواعد البيانات دون انتهاك الحقوق، فلا تتردد في طرحها!

Dim db As DAO.Database
Dim td As DAO.TableDefs
Dim sql As String
Dim t As DAO.TableDef

Set db = CurrentDb()
Set td = db.TableDefs

For Each t In td
    ' تخطي الجداول النظامية والجداول المؤقتة
    If Left(t.Name, 4) = "MSys" Or Left(t.Name, 1) = "~" Then GoTo Continue

    ' بناء جملة SQL الديناميكية
    sql = "DELETE * FROM [" & t.Name & "]"
    
    ' تنفيذ الجملة SQL
    DoCmd.RunSQL sql

Continue:
Next t

MsgBox "All records in all tables are deleted"
Me.Requery

DoCmd.RunCommand acCmdSaveRecord
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim nameExists As Boolean

Set db = CurrentDb
nameExists = False

' التحقق مما إذا كان الاسم موجودًا بالفعل في الجدول
Set rst = db.OpenRecordset("SELECT [NAME ARABIC] FROM TABELSIMCARD WHERE [NAME ARABIC] = '" & Me.D2 & "'", dbOpenSnapshot)

If Not rst.EOF Then
    ' إذا تم العثور على السجل، فذلك يعني أن الاسم موجود
    nameExists = True
End If

rst.Close
Set rst = Nothing
Set db = Nothing

' إذا كان الاسم موجودًا بالفعل، عرض رسالة تحذيرية وعدم الحفظ
If nameExists Then
    MsgBox "الاسم '" & Me.D2 & "' الموظف موجود مسبقاً في نظام الكشوفات الخاصة ببطاقات الهاتف.", vbExclamation
    ' إذا كان الاسم مكرر، عدم حفظ السجل
    Me.Undo ' لإلغاء إضافة السجل الحالي
Else
    ' إذا لم يكن الاسم مكرر، سيتم حفظ السجل بدون عرض أي رسالة
    ' الكود لحفظ السجل يمكن أن يقوم به الأمر DoCmd.RunCommand acCmdSaveRecord
End If

7 دقائق مضت, Abdelaziz Osman said:

الكود الثانى

Private Sub Form_BeforeUpdate(Cancel As Integer)
    Dim t54Value As Integer
    Dim devValue As String
    Dim response As Integer

    t54Value = Me.t54
    devValue = Me.dev

    ' تحقق إذا كانت قيمة t54 تساوي 6 وأيضاً إذا dev لا يحتوي على الرقم 5
    If t54Value = 6 And Not devValue Like "*5" Then
        ' إظهار رسالة تأكيد
        response = MsgBox("الحقل dev يجب أن يحتوي على الرقم 5. هل ترغب في الاستمرار؟", vbYesNo + vbExclamation, "تأكيد")

        If response = vbNo Then
            ' إذا اختار المستخدم "لا"، أعد الحقل t54 إلى Null أو القيمة الافتراضية
            Me.t54 = Null ' أو يمكنك تعيين قيمة معينة بدلًا من Null
            Cancel = True ' يمنع إغلاق النموذج
        End If
    End If

    ' تحقق إذا كان المستخدم يحاول الخروج بدون كتابة رقم الطلب الذي يبدأ برقم 5
    If devValue = "" Or Left(devValue, 1) <> "5" Then
        ' تعيين القيم المطلوبة
        Me.t54 = 1
        Me.dev = "لم يتم كتابة رقم الطلب أثناء التنفيذ"

        ' إظهار رسالة تنبيه
        MsgBox "تم الغاء التحديث لم يتم كتابة رقم الطلب", vbInformation, "تنبيه"
        
        Cancel = True ' يمنع إغلاق النموذج
    End If
End Sub

شرح للمتغير عن الكود السابق.

تم إنشاء شرط إضافي للتحقق إذا كان الحقل dev فارغًا أو لا يبدأ برقم 5.

إذا تحقق الشرط، نقوم بتعيين t54 إلى 1 و dev إلى "لم يتم كتابة رقم الطلب أثناء التنفيذ".

تظهر رسالة تنبيه تخبر المستخدم بأنه تم إلغاء التحديث.

يتم تعيين Cancel إلى True لمنع إغلاق النموذج إذا كانت الشروط مستوفاة.

بهذا الشكل، ستحقق ما تريده.

اتمني التجربة و الرد صديقي

54 دقائق مضت, Abdelaziz Osman said:

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

انه إذا قام المستخدم  بالخروج قبل كتابة رفم الطلب الذى يبدأ برقم 5

يقوم الاكسيس بتغيير t54=1

و dev = "لم يتم كتابة رقم الطلب أثناء التنفيذ"

وبدون أي رسالة نعم أو لا

فقط ان امكن رسالة تنبيه مفادها "تم الغاء التحديث لم يتم كتابة رقم الطلب"

اي كود تم تنفيذة ؟ لكي اقوم بتعديل عليه

جرب

Private Sub Form_BeforeClose(Cancel As Integer)
    Dim userResponse As Integer
    
    ' تحقق من الشرط
    If Me.t54 = 6 Then
        If Not (Me.dev Like "5000000000") Then
            ' عرض رسالة تأكيد
            userResponse = MsgBox("هل تريد إعادة الحقل dev إلى القيمة السابقة؟", vbYesNo + vbQuestion, "تأكيد")
            If userResponse = vbYes Then
                ' قم بإعادة الحقل إلى القيمة السابقة
                Me.dev = "" ' أو قم بتغيير هذا إلى القيمة التي تريد إعادة تعيينها
                ' يمكنك أيضاً إضافة كود هنا لتخزين القيمة السابقة قبل تغييرها
            End If
        End If
    End If
End Sub

او

Private Sub Form_BeforeUpdate(Cancel As Integer)
    Dim t54Value As Integer
    Dim devValue As String
    Dim response As Integer

    t54Value = Me.t54
    devValue = Me.dev

    ' تحقق إذا كانت قيمة t54 تساوي 6 وأيضاً إذا dev لا يحتوي على الرقم 5
    If t54Value = 6 And Not devValue Like "*5" Then
        ' إظهار رسالة تأكيد
        response = MsgBox("الحقل dev يجب أن يحتوي على الرقم 5. هل ترغب في الاستمرار؟", vbYesNo + vbExclamation, "تأكيد")

        If response = vbNo Then
            ' إذا اختار المستخدم "لا"، أعد الحقل t54 إلى Null أو القيمة الافتراضية
            Me.t54 = Null ' أو يمكنك تعيين قيمة معينة بدلًا من Null
            Cancel = True ' يمنع إغلاق النموذج
        End If
    End If
End Sub

وعليكم السلام

اقتباس و توضيح فقط لا اكثر

1. افتح نموذجك في وضع التصميم.
2. انقر بزر الماوس الأيمن على الحقل "dev" واختر "خصائص".
3. اذهب إلى علامة التبويب "الحدث" وابحث عن "After Update".
4. انقر على زر "..." الموجود بجوار "After Update" لفتح محرر VBA.
5. أدخل الكود التالي:

```vba
Private Sub dev_AfterUpdate()

    If Me.dev < 5000000000 Then
        MsgBox "القيمة المدخلة يجب أن تكون 5000000000 أو أكبر. سيتم التراجع عن التحديث."
        
        ' قم بإعادة الحقل إلى حالته السابقة
        Me.Undo
    End If

End Sub

### شرح الكود:
- `Private Sub dev_AfterUpdate()`: هذا هو حدث "After Update" الخاص بحقل "dev".
- `If Me.dev < 5000000000 Then`: يتحقق مما إذا كانت القيمة المدخلة أقل من 5000000000.
- `MsgBox`: يعرض رسالة تنبه المستخدم بأن القيمة المدخلة غير صحيحة.
- `Me.Undo`: يقوم بالتراجع عن التحديث وإعادة القيمة السابقة للحقل.

بهذا الشكل، إذا أدخل المستخدم قيمة أقل من 5000000000، سيظهر تحذير وسيتراجع عن التحديث.

طلبي شرح او تعديل

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

وشكرا

السلام عليكم

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

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

وشكرا لكم

تحضير يومي.xlsx

ارغب في تعديل الواجهات كيف افعل ذلك ؟

لان في حالة التعديل تضهر لي واجهه واحد

حاليا عند فتح الملف ارغب في تعديل بعض الخانات في الفورم فتضهر عندي فروم واحد ولا استطيع التنقفل بين الفريمات

بمعني ارغب بتعديل على الواجهه  مثل التقرير الشهري وارقام الصفوف و التقرير اليومي وسجل الحضور

لكن يضهر معي فقط عرض البيانات كما هو موجود في صورة شاشة vb

وشكرا لك مقدما

صباح الخير هل ..

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

وشكرا مقدما

حضور وغياب - يوزر فورم--.xlsm

شكرا لك

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

محتاج فورم ادخل بيانات يتكون من

اسم المعداة

كود المعداة

ومكان تواجد المعداة ( اي مخزن ) 4 مخازن كومبو بوكس

وتاريخ الصيانة

وامكانية اضافة صورتين للمعداه تظهر في الفورم

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

وشكرا لكم مقدما

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

السلام عليكم

لقية موضوع لكن المشكله للاكسس وارغب بكود لاخذ صوره بالاكسل

Private Const iScanner As Long = 1764
Dim iSh
Private Sub Cmd_Pic_Folder_Click()
May_Pic = Application.GetOpenFilename("Picture Files (*.jpg; *.jpeg; *.bmp; *.gif),*.jpg; *.jpeg; *.bmp; *.gif")
    If May_Pic = False Then Exit Sub
On Error GoTo 1
    Set Image1.Picture = LoadPicture(May_Pic)
Exit Sub
1
MsgBox "هذا النوع من الصور غير معتمد في البرنامج", vbExclamation + vbMsgBoxRight, " "
End Sub

Private Sub CmdSA_Click()
On Error GoTo 1
  Set s = iSh.Shapes(CStr(Me.Text_PicTo_Copy))
  s.CopyPicture
  iSh.ChartObjects.Add(0, 0, s.Width, s.Height).Chart.Paste
  iSh.ChartObjects(1).Chart.Export Filename:="monimage.jpg"
  iSh.Shapes(iSh.Shapes.Count).Delete
  Me.Image1.PictureSizeMode = fmPictureSizeModeZoom
  Me.Image1.Picture = LoadPicture("monimage.jpg")
  Kill "monimage.jpg"
1
Dim N_Pic As String
If TBN_Pic.Text = "" Then Exit Sub
N_Pic = ThisWorkbook.Path & "\SW\S\" & TBN_Pic & ".jpg" 'bmp
SavePicture Image1.Picture, N_Pic
UserForm1.LabelPic.Caption = N_Pic
Application.Visible = False
Unload Me
End Sub

Private Sub CmdWA_Click()
On Error GoTo 1
  Set s = iSh.Shapes(CStr(Me.Text_PicTo_Copy))
  s.CopyPicture
  iSh.ChartObjects.Add(0, 0, s.Width, s.Height).Chart.Paste
  iSh.ChartObjects(1).Chart.Export Filename:="monimage.jpg"
  iSh.Shapes(iSh.Shapes.Count).Delete
  Me.Image1.PictureSizeMode = fmPictureSizeModeZoom
  Me.Image1.Picture = LoadPicture("monimage.jpg")
  Kill "monimage.jpg"
1
Dim N_Pic As String
If TBN_Pic.Text = "" Then Exit Sub
N_Pic = ThisWorkbook.Path & "\SW\W\" & TBN_Pic & ".jpg" 'bmp
SavePicture Image1.Picture, N_Pic
UserForm1.LabelPic.Caption = N_Pic
Application.Visible = False
Unload Me
End Sub

Private Sub CommandButton2_Click()
On Error Resume Next
Set iSh = Sheets("PH")
iSh.Activate
Application.CommandBars.FindControl(ID:=1764).Execute
  For Each s In iSh.Shapes
  Me.Text_PicTo_Copy.Text = s.Name
  Next
Application.Visible = False
End Sub

Private Sub sCancel_Click()
Unload Me
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then Cancel = True
End Sub

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

وشكرا لكم

هل من مساعدة ؟

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

تم ارفاق قاعدة البيانات

وارغب في هذه التعديلات لوسمحتو

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

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

Microsoft Access Database 8.rar