MOHAMMAD IBRAHIM

المشكلة في الكود هي أنه يستخدم التوقيت المحلي كنقطة بداية ثم يضيف عليه الساعات، مما يؤدي إلى حسابات غير صحيحة. يجب أن نستخدم توقيت غرينتش (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

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: في حالة العمل مع هذه الصيغ، هناك خيارات شرعية، مثل: إنشاء قاعدة بيانات جديدة: يمكنك استيراد المكونات مع مراعاة وجود كلمة المرور. ضرورة احترام حقوق المبرمجين: من المهم دائمًا احترم عمل الآخرين وعدم انتهاك حقوق الملكية الفكرية. نحن هنا لتقديم المساعدة والإرشادات، لكن من المهم أن نكون واعين للأثر الذي قد تحدثه أفعالنا على الآخرين في هذا المجال. ختامًا: إذا كانت لديك استفسارات أو تحتاج إلى مساعدة في جوانب أخرى ضمن البرمجة أو قواعد البيانات دون انتهاك الحقوق، فلا تتردد في طرحها!

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

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 لمنع إغلاق النموذج إذا كانت الشروط مستوفاة. بهذا الشكل، ستحقق ما تريده. اتمني التجربة و الرد صديقي

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

جرب 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