sm44ms

اشكركم جميعا ماقصرتوا يعطيكم الف عافية - ممتاز جدا

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

الملف كبير حاولت ولم اقدر ارفعه

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

اولا شكرا الف شكر هو كان سوال فقط عادي وقمت باتباع ماقلت انه وظبط الموضوع شكرا جزيلات

فيه شي طريقة لتغيير واجهة موقع اوفسينا الى العربية

السلام عليكم يا اصدقائي الاعزاء عندي نموذجين كالتالي FINISHED CAED TEMPLATE نموذج رئيسي افتحتة للعرض FINISHED CAED نموذج صغير يفتح فقط عند فتح الرئيسي ولكن صادفتني مشكلة انه يفتح النموذج الصغير في الخلف وليس في الامام انا اريدة عند فتح النموذج الرئيسي يفتح النموذج الصغير في الامام سويت كود له ولكن لم يفتح - مرفق لكم الكود الكود معمول عند الفتح الفتح للنموذج الرئيسي Private Sub Form_Open(Cancel As Integer) Dim db As DAO.Database Dim rst As DAO.Recordset Dim expiredCount As Long Dim activeCount As Long Set db = CurrentDb ' عد البطاقات المنتهية Set rst = db.OpenRecordset("SELECT COUNT(*) AS ExpiredCount FROM Table11 WHERE Expiry_Date < Date()") expiredCount = rst!expiredCount rst.Close ' عد البطاقات النشطة Set rst = db.OpenRecordset("SELECT COUNT(*) AS ActiveCount FROM Table11 WHERE Expiry_Date >= Date()") activeCount = rst!activeCount rst.Close Set rst = Nothing Set db = Nothing ' افتح النموذج المصغر الصغير DoCmd.OpenForm "FINISHED CAED", acNormal ' مرر البيانات إلى الحقول في النموذج المصغر FORMS("FINISHED CAED").Controls("EXP").Value = expiredCount FORMS("FINISHED CAED").Controls("FAL").Value = activeCount ' تشغيل المؤقت المؤقت لتقديم النموذج المصغر للأمام بعد الفتح Me.TimerInterval = 100 ' 100 مللي ثانية ' يمكنك تعليق رسالة MsgBox لأنك تعرض البيانات في النموذج الصغير ' MsgBox "لديك " & expiredCount & " من البطاقات المنتهية." & vbCrLf & _ ' "ولديك " & activeCount & " من البطاقات النشطة في النظام والان يتم عرض المنتهية فقط.", vbInformation, "حالة البطاقات" End Sub

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

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

اشكركم جميعا؟ Foksh الاخ جربت على التقرير عندي ولم يعمل سوف اجرب وارد لكم اليوم kkhalifa1960 الاخ يعني انسخ المربع فيوق الصوره

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

لا الصوره الاخير الذي تحت اريدها خفيفه جدا على شكل خلفيه

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

اشكرك

اشتغل ؟ ولكن فيه خطاء في التوقيت العالمي مثال - انا في ابوظبي والفرق بينها ومكة ساعه نفس الشي في عدن وبعض المدن والفرق كبير 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 ' الحصول على الوقت حسب المنطقة الزمنية الحالية Select Case currentTimeZone Case 0 ' أبوظبي (UTC+4) Me.Text2 = Format(dateadd("h", 4, TimeSerial(Hour(Time), Minute(Time), Second(Time))), "hh:nn:ss AM/PM") & " أبوظبي" Case 1 ' مكة المكرمة (UTC+3) Me.Text2 = Format(dateadd("h", 3, TimeSerial(Hour(Time), Minute(Time), Second(Time))), "hh:nn:ss AM/PM") & " مكة المكرمة" Case 2 ' توقيت غرينتش (UTC+0) Me.Text2 = Format(TimeSerial(Hour(Time), Minute(Time), Second(Time)), "hh:nn:ss AM/PM") & " غرينتش" Case 3 ' موسكو (UTC+3) Me.Text2 = Format(dateadd("h", 3, TimeSerial(Hour(Time), Minute(Time), Second(Time))), "hh:nn:ss AM/PM") & " موسكو" Case 4 ' نيويورك (UTC-5) Me.Text2 = Format(dateadd("h", -5, TimeSerial(Hour(Time), Minute(Time), Second(Time))), "hh:nn:ss AM/PM") & " نيويورك" Case 5 ' طوكيو (UTC+9) Me.Text2 = Format(dateadd("h", 9, TimeSerial(Hour(Time), Minute(Time), Second(Time))), "hh:nn:ss AM/PM") & " طوكيو" Case 6 ' عدن (UTC+3) Me.Text2 = Format(dateadd("h", 3, TimeSerial(Hour(Time), Minute(Time), Second(Time))), "hh:nn:ss AM/PM") & " عدن" Case 7 ' القاهرة (UTC+2) Me.Text2 = Format(dateadd("h", 2, TimeSerial(Hour(Time), Minute(Time), Second(Time))), "hh:nn:ss AM/PM") & " القاهرة" Case 8 ' بكين (UTC+8) Me.Text2 = Format(dateadd("h", 8, TimeSerial(Hour(Time), Minute(Time), Second(Time))), "hh:nn:ss AM/PM") & " بكين" Case 9 ' باريس (UTC+1) Me.Text2 = Format(dateadd("h", 1, TimeSerial(Hour(Time), Minute(Time), Second(Time))), "hh:nn:ss AM/PM") & " باريس" Case 10 ' لندن (UTC+0) Me.Text2 = Format(TimeSerial(Hour(Time), Minute(Time), Second(Time)), "hh:nn:ss AM/PM") & " لندن" End Select End If End Sub

ياصديقي - حصلت معي مشكلة هنا - لاني استخدم كود ثاني مع هذا وارفق لك الكود لتعدلهOption Compare Database 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 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 [ss].BackColor = vbRed Else [BD].ForeColor = vbWhite [BD].BackColor = vbRed End If Else [BD].ForeColor = vbBlack [BD].BackColor = vbYellow End If End Sub 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 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 [ss].BackColor = vbRed Else [BD].ForeColor = vbWhite [BD].BackColor = vbRed End If Else [BD].ForeColor = vbBlack [BD].BackColor = vbYellow End If End Sub سبب مشكلة هنا ولم يعمل Option Compare Database

حلو ه الفكره ولكن كيف فتح عدد 2 محرر اكود لنفس الحدث لاني اريد كود الوقت لبعض الدول مثل ابوظبي مكة قرينتش موسكو في حقل واحد وتتغير كل 5 ثواني بين كل دوله في التوقيت

السلام عليكم كيفية دمج كودين في حدث واحد على سبيل المثال عندي كود للساعة وعداد الوقت 1000 واريد ان اضيف كود اخر في نفس الحدث وعدادا الوقت 5000 لاني حاولت ان ادمج بالكود نفسه لكن حصل مشكلة في العمل سالت : قالو ممكن تفتح محرر الاكود مرتين لنفس النموذج - لكن لم اجد الطريقه في اوفيس 2007 هل عنده الفكره جزاكم الله خيرا

هلاهلا - وهل يفتي ومالك في المدينة؟ ع العموم شكرا على تواضعك هذا - اما بخصوص الانترنت نعم يجب ان تكون متصل بالانترنت؟ اما ملف الجنسيات موجود عندي كامل به كل الجنسيات اذا تبيه برسله لك نعود للكود Private Sub Drive_Nat_AfterUpdate() On Error Resume Next ' استدعاء الدالة Translate لترجمة الجنسية العربي إلى الإنجليزي Dim translatedText As String translatedText = Translate(Me.Drive_Nat.Value, "ar", "en") ' هذه هو مربع التحرير الخاص بك Drive_Nat ' تحديث حقل الجنسيات الإنجليزية NASH If Not IsNull(translatedText) And translatedText <> "" Then ' NASH وهذا مربع التحرير الخاص بالجنسية العربية اذا كان لديك Me.NASH.Value = translatedText Else MsgBox "تعذر الترجمة. يرجى المحاولة مرة أخرى.", vbExclamation, "خطأ في الترجمة" End If ' وهذا حقل الجنسية العربيه بحيث ييم الترجمة فيه ' تحديث الحقل NAOINALTYEN بناءً على الترجمة If Not IsNull(Me.NASH.Value) And Me.NASH.Value <> "" Then Me.NAOINALTYEN.Value = Me.NASH.Value End If ' استدعاء الكود الخاص بتحديث الصور Call NASH_AfterUpdate End Sub قبل ذلك تضع هذا الكود في وحدة نمطية واحفظها Option Compare Database Option Explicit Public Function Translate(strInput As String, strFromSourceLanguage As String, strToTargetLanguage As String) As String Dim strURL As String Dim objHTTP As Object Dim objHTML As Object Dim objDivs As Object, objDiv As Object Dim strTranslated As String strURL = "https://translate.google.com/m?sl=" & strFromSourceLanguage & "&tl=" & strToTargetLanguage & "&q=" & EncodeQP2(strInput) & "&hl=ar" Set objHTML = Nothing Set objHTTP = CreateObject("Msxml2.XMLHTTP.6.0") objHTTP.Open "GET", strURL, False objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)" objHTTP.SEND "" Set objHTML = CreateObject("htmlfile") With objHTML .Open .Write objHTTP.responseText .Close End With Set objDivs = objHTML.getElementsByTagName("div") For Each objDiv In objDivs If objDiv.className = "result-container" Then strTranslated = objDiv.innerText Translate = strTranslated End If Next objDiv End Function Function EncodeQP2(s As String) As String Dim i As Long Dim p1 As Long Dim p2 As Long Dim R As String Dim n As Long For i = 1 To Len(s) n = AscW(MID(s, i, 1)) If n < 128 Then R = R & "%" & Hex(n) ElseIf n < 2048 Then p1 = n \ 64 R = R & "%" & Hex(p1 + 192) p2 = n Mod 64 R = R & "%" & Hex(p2 + 128) Else End If Next i EncodeQP2 = R End Function

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

اشكرك الف شكر اخي؟ يعلة والديك الجنة

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

ممكن

اريد تعديل على الكود بحيث اذا اخترت من القائمة KH تفتح النماذج المخصص فيها واذا اخترت من القايمة TW تفتح النماذج الخصصه له طبعا بعد الضغط هلى اسم النموذج في القائمة Private Sub KH_Click() ' إعادة تعيين جميع المربعات لتكون فارغة ClearAllLists ' تعبئة القوائم للنماذج المختلفة عند الضغط على KH Me.lstForms1.AddItem "شاشة اصدار البطاقات;FO1" Me.lstForms2.AddItem "شاشة تجديد البطاقات;FO2" Me.lstForms3.AddItem "شاشة تعديل بيانات البطاقات;FO3" Me.lstForms4.AddItem "شاشة تعديل بيانات اساسية فرعية;FO4" Me.lstForms5.AddItem "شاشة اصدار بطاقات المتقاعدين;FO5" Me.lstForms6.AddItem "شاشة البطاقات المنتهية;FO6" Me.lstForms7.AddItem "شاشة الملف الشخصي العام;FO7" End Sub Private Sub TW_Click() ' إعادة تعيين جميع المربعات لتكون فارغة ClearAllLists ' تعبئة القوائم للنماذج الخاصة بـ TW عند الضغط على TW Me.lstForms1.AddItem "شاشة الملف التاريخي العام;TW1" Me.lstForms2.AddItem "حركة الملفات التاريخية;TW2" Me.lstForms3.AddItem "الملف التاريخي;TW3" Me.lstForms4.AddItem "حالة المعاملات التاريخية;TW4" Me.lstForms5.AddItem "الشاشة قيد الاجراء;TW5" Me.lstForms6.AddItem "شاشة قيد الاجراء 2;TW6" Me.lstForms7.AddItem "شاشة الملف ;TW7" End Sub Private Sub ClearAllLists() ' إعادة تعيين جميع مربعات القوائم إلى الحالة الافتراضية Me.lstForms1.RowSource = "" Me.lstForms1.Value = Null Me.lstForms2.RowSource = "" Me.lstForms2.Value = Null Me.lstForms3.RowSource = "" Me.lstForms3.Value = Null Me.lstForms4.RowSource = "" Me.lstForms4.Value = Null Me.lstForms5.RowSource = "" Me.lstForms5.Value = Null Me.lstForms6.RowSource = "" Me.lstForms6.Value = Null Me.lstForms7.RowSource = "" Me.lstForms7.Value = Null End Sub Private Sub lstForms1_AfterUpdate() HandleFormOpen Me.lstForms1 End Sub Private Sub lstForms2_AfterUpdate() HandleFormOpen Me.lstForms2 End Sub Private Sub lstForms3_AfterUpdate() HandleFormOpen Me.lstForms3 End Sub Private Sub lstForms4_AfterUpdate() HandleFormOpen Me.lstForms4 End Sub Private Sub lstForms5_AfterUpdate() HandleFormOpen Me.lstForms5 End Sub Private Sub lstForms6_AfterUpdate() HandleFormOpen Me.lstForms6 End Sub Private Sub lstForms7_AfterUpdate() HandleFormOpen Me.lstForms7 End Sub Private Sub HandleFormOpen(lst As Control) ' تحقق من العنصر المحدد في مربع القائمة Dim selectedIndex As Integer selectedIndex = lst.ListIndex If selectedIndex = -1 Then MsgBox "يرجى اختيار عنصر من القائمة.", vbExclamation Exit Sub End If Select Case selectedIndex Case 0 ' فتح أكثر من نموذج عند Case 0 If Not IsFormOpen("MECARD") Then DoCmd.OpenForm "MECARD" If Not IsFormOpen("FEND HOSTRY") Then DoCmd.OpenForm "FEND HOSTRY" Case 1 If Not IsFormOpen("FORM2") Then DoCmd.OpenForm "FORM2" If Not IsFormOpen("FORM29") Then DoCmd.OpenForm "FORM29" Case 2 If Not IsFormOpen("FORM3") Then DoCmd.OpenForm "FORM3" Case 3 If Not IsFormOpen("FORM4") Then DoCmd.OpenForm "FORM4" Case 4 If Not IsFormOpen("FORM5") Then DoCmd.OpenForm "FORM5" Case Else MsgBox "النموذج غير موجود." End Select End Sub Private Function IsFormOpen(formName As String) As Boolean ' التحقق إذا كان النموذج مفتوح بالفعل On Error Resume Next IsFormOpen = (CurrentProject.AllForms(formName).IsLoaded) On Error GoTo 0 End Function Private Sub Form_Load() ' إعادة تعيين مربعي القوائم عند فتح النموذج Me.lstForms1.RowSource = "" ' تفريغ مربع القائمة الأول Me.lstForms2.RowSource = "" Me.lstForms3.RowSource = "" Me.lstForms4.RowSource = "" Me.lstForms5.RowSource = "" Me.lstForms6.RowSource = "" Me.lstForms7.RowSource = "" End Sub

اشكرك اخي