أبو هادي

السلام عليكم لم أجرب مثال أخي محمد طاهر ولكني أعتقد أنك بحاجة إلى تغيير تنسيق الخلية إلى رقمي . كما يمكن أن تحصل على المطلوب بدون كود وذلك بضرب الخلية في 24 وتغيير تنسيق الخلية كذلك إلى رقمي . مثلا لو الوقت موجود في خلية A1 ففي خلية أخرى نضع المعادلة التالية : A1*24= تحياتي .

السلام عليكم أخي محمد طاهر الملف فتح معي ولكن يبدو أنه معطوب أو أن المشكلة معي في الوورد لأن الموضوع تكرر معي أكثر من مرة . عموما فضلت أن أترك الحل بيد المستخدم حيث قمت بإضافة مدخلين لجمع العملة والكسر . مرفق مثال بعد التعديل . تحياتي . الملفات المرفقة Num2Text_97.zip ( 71.96k ) عدد مرات التحميل: 857

السلام عليكم مثال لتحويل الأوزان والمقاييس بعد إضافة قسم جديد قسم مقاييس الحرارة . توجد وحدتان بقسم مقاييس الحرارة لم أستطع الحصول على ترجمة عربية لهما .. آمل من يستطيع ترجمتهما إضافتهما وشكرا سلفا . آمل أن يحوز على رضاكم . تحياتي . الملفات المرفقة Measuers.zip ( 87.61ك ) عدد مرات التنزيل: 174

السلام عليكم بعد إذن Sharaf ومحمد طاهر هذا مثال قديم يجسد استخدام الإستهداف آمل أن يكون مفيدا تحياتي . Installments.zip

السلام عليكم تم التعديل على التفقيط الإنجليزي ويبقى عملية إضافة s الجمع فهل هي مطلوبة هنا وخصوصا أنه كثير من الأحيان يستخدم اختصارات للعملة مثل S.R أو علامة الدولار $ . تم معالجة القيم Null بعد عمل دالة شبيهة للـ Nz حيث هي غير متوفرة في الأكسل ومطلوبة بشدة في الأكسس وهي بإسم myNz . شكرا لكل من أبدى برأيه وملاحظاته ولازلت بانتظار المزيد . تحياتي . الملفات المرفقة Num2Text_97.zip ( 56.12ك ) عدد مرات التنزيل: 267

السلام عليكم استخدم علامة التنصيص المفردة ' قبل الأرقام التي تريد أن تظهر بشكلها الصحيح عندما تبدأ بالأصفار فهذه العلامة تجبر القيمة أن تكون نصية كذلك تستطيع استخدامها في حالة ما أردت استبعاد أي رقم من من مجموع عدة خلايا عند استخدام دالة التجميع Sum . بدلا من كتابة الرقم 00125 أكتبه هكذا 00125' تحياتي .

السلام عليكم تفقيط محدث بدالتي جديدتين واحدة للعربي ArbNum2Text وأخرى للإنجليزي EngNum2Text وتم الفصل بينهما بعد إن كانتا في دالة واحدة وذلك لوجود فرق في عدد المدخلات تصل إلى 4 مدخلات . والتحديث الآن تركز على تسهيل استخدام الدوال وخصوصا العربي مع استخدام المدخلات الإختيارية والتي كانت سابقا كلها مدخلات مطلوبة . لي ملاحظة واحدة فقط وتحتاج إلى آرائكم وهي تفقيط الكسر للدالة الإنجليزي وخصوصا أن الدالة تبدأ بالعملة أولا ثم تحويل الأرقام إلى حروف وعند الكسر يكون العكس ، الشيء الذي لا يروق لي .. فمن له دراية بالموضوع أرجو التكرم بتقديم مالديه من معلومات ولكم جزيل الشكر سلفا . الكود معمول لللأكسس والأكسل معا . تحياتي . الملفات المرفقة Num2Text20030725.zip ( 74.73ك ) عدد مرات التنزيل: 626

السلام عليكم إضافة تحسينات كثيرة وأهمها عرض النتيجة بنفس النموذج وإمكانية حذف جدول الشواغر . تحياتي . MissingSeq.zip

السلام عليكم كلك ذوق أخي محمد .. مشكلتي هي اعتقادي أن كل الناس معي (على خط واحد) أي فاهميني فآمل من الجميع أن يعذرني على ذلك وسأحاول مستقبلا أن أشرح ما أطرحه بقدر الإمكان إن شاء الله . تحياتي .

السلام عليكم مجرد فكرة للحفاظ على التسلسل في حالة ما إذا كانت الصفحة محمية . تحياتي . SerialNumber.zip

السلام عليكم هذا الكود سوف ينشئ جدول جديد يحتفظ فيه بالأرقام الشاغرة (غير المشغولة) ، فقط يحتاج منك تبديل إسم الجدول وإسم الحقل في الكود المرفق . Sub FindMissingSeq() Dim dbs As Database Dim rst As Recordset Dim tdfNew As TableDef Dim mis As Recordset Dim LastSeq As Long Dim FieldName As String Dim MasterTable As String Dim MissingTable As String Dim msg As String On Error Resume Next '-------------------------------------------------------------------' MasterTable = "TS-t-Transactions" '-- ÃßÊÈ ÅÓã ÇáÌÏæá --' FieldName = "Seq" '-- ÃßÊÈ ÅÓã ÇáÍÞá ÇáÐí íÍÊæí Úáì ÇáÃÑÞÇã ÇáãÓáÓáÉ --' '-------------------------------------------------------------------' Set dbs = CurrentDb Set rst = dbs.OpenRecordset(MasterTable, dbOpenSnapshot) rst.Sort = FieldName Set rst = rst.OpenRecordset MissingTable = MasterTable & "_Missing_" & FieldName Set mis = dbs.OpenRecordset(MissingTable, dbOpenDynaset) If Err.Number = 3078 Then Set tdfNew = dbs.CreateTableDef(MissingTable) With tdfNew .Fields.Append .CreateField("From_" & FieldName, dbLong) .Fields.Append .CreateField("To_" & FieldName, dbLong) .Fields.Append .CreateField("Records", dbLong) End With dbs.TableDefs.Append tdfNew Set mis = dbs.OpenRecordset(MissingTable, dbOpenDynaset) Else DoCmd.Close acTable, MissingTable Set mis = dbs.OpenRecordset(MissingTable, dbOpenDynaset) With mis .MoveFirst Do While Not .EOF .Delete .MoveNext Loop End With End If msg = "ãä æÇÍÏ ¿ " & FieldName & " åá ÊÑíÏ Ãä ÊÈÏà ÃÑÞÇã ÍÞá" & vbCrLf & _ "ÅÐÇ ÃÑÏÊ Ãä ÊÈÏà ãä ÈÏÇíÉ ÇáÃÑÞÇã Ýí ÇáÌÏæá ÅÎÊÑ áÇ" With rst .MoveFirst If vbYes = MsgBox(msg, vbYesNo) Then LastSeq = 0 Else LastSeq = rst("[" & FieldName & "]") .MoveNext End If Do While Not .EOF If rst("[" & FieldName & "]") - LastSeq > 1 Then mis.AddNew mis("[From_" & FieldName & "]") = LastSeq + 1 mis("[To_" & FieldName & "]") = rst("[" & FieldName & "]") - 1 mis("[Records]") = rst("[" & FieldName & "]") - LastSeq - 1 mis.Update End If LastSeq = rst("[" & FieldName & "]") .MoveNext Loop End With mis.Close rst.Close Set dbs = Nothing DoCmd.OpenTable MissingTable, , acReadOnly End Sub هذا الكود يصلح لحقل رقمي فقط . الكتابة العربية الموجودة بالكود كالتالي : 1 - أكتب اسم الجدول 2 - أكتب اسم الحقل الذي يحتوي على الأرقام المسلسلة 3 - هل تريد أن تبدأ أرقام حقل ..... من واحد ؟ 4 - إذا أردت أن تبدأ من بداية الأرقام في الجدول اختر لا تحياتي

السلام عليكم المطلوب : 1 - وجود شبكة نوفل أو ويندوز سيرفر 2000 . 2 - اختيار أحد الملفين الموضحين أعلاه وذلك بعد الضغط المزدوج على صندوق النص Path أو كتابة الملف ومساره إذا كنت متأكد من وجوده . 3 - أن تكتب رسالتك في صندوق نص Message . 4 - أن يكون جهاز المرسل إليه مفتوح حتى يتلقى الرسالة .. أما أنت فلن ترى أي نتيجة في جهازك . :) 5 - أن تدعي لي دعوة صالحة عندما يعمل معك المثال وأن تسامحني في حالة لم توفق في ذلك . وأهم ما في الموضوع أنك ما تزعل تحياتي .

السلام عليكم شكرا لك أخي محمد طاهر . بالنسبة لأجهزة 98 يوجد ملف باسم winpopup.exe عادة يوجد على C:\windows يجب تشغيله ليتمكن من استقبال هذه الرسائل طبعا يفضل عمل minimize له . كما يفضل وضعه في Startup ليعمل تلقائيا مع فتح الجهاز . ولكن هناك مشكلة واجهتني لعدم تمكن استلام رسالة أخرى حتى يتم اقفال هذا الملف وفتحه من جديد . في حالة وجود مشاكل يكون سببها وجود component مطلوب إزالته ولكن للحقيقة لا أملك وصفه الآن . وهو موجود على : Control Panel Network Configuration تحياتي .

السلام عليكم موضوع قديم عملته سابقا لشبكات نوفل Novell وحسب ما أعتقد لم يستفد منه أحد لقلة مستخدمي نظام نوفل ، ولكنه الآن يعمل على شبكات الويندوز والنوفل . المطلوب فقط اختيار ملف الرسائل وهو كالتالي : للنوفل : send.exe ويكون عادة على \Public\\ . للوندوز : net.exe ويكون عادة على \C:\Windows\System32 . المرسل إما مستخدم واحد أو متعدد أو للجميع . وينقصه فقط الإرسال إلى سيرفر واحد في حالة وجود أكثر من سيرفر ، فإذا رغبتم بإضافة هذه الخاصية أضفناها بعد أن يتم تجربة المثال وإطلاعنا على النتائج مشكورين سلفا . تحياتي . الملف المرفق ( عدد مرات التنزيل: 118 ) POP_UP_1997.zip

السلام عليكم عذرا ، يفترض أن أضع نسخة 2000 وبالخطأ وضعت نسخة 2002 . تحياتي . الملفات المرفقة ArbMsgBox_2000.zip ( 32.73ك ) عدد مرات التنزيل: 106

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

السلام عليكم من العيوب في الكود السابق أنه يعمل في النماذج فقط وحتى في النماذج لا يعمل حتى يتحمل النموذج بمعنى لو تم استعمال الدالة في حدث عند التحميل أو عند الفتح فلن تعمل . الآن .. الدالة تعمل مع النماذج والتقارير والوحدات النمطية . والمشكلة الوحيدة الآن التي أواجهها الآن هي عدم عمل الدالة إذا كان النموذج منبثق PopUp وسوف أستمر في المحاولة إن شاء الله . إضطررت لنجاح عمل الدالة أن أصمم نموذج باسم ArbMsgBox_frm آمل عدم حذفه أو التعديل في خصائصه . تحياتي . الملفات المرفقة ArbMsgBox_2000.zip ( 35.14ك ) عدد مرات التنزيل: 92

السلام عليكم شكرا أخي محمد طاهر .. الفكرة جميلة وتحل المشكلة لو كان الأمر بشكله الموضح ثابت لا يتبدل ولكن لن تكون فعالة معي لرغبتي في فتح النموذج بشكل متعدد ومن مواقع متعددة فمثلا قد احتاج في الكود أعلاه أن أطلب نموذج1 أكثر من مرة في إجراء test وقد أطلبه كذلك من modules أخرى . تحياتي .

السلام عليكم على سبيل المثال الكود التالي يحتوي على مجموعة أوامر وفي منتصفها أمر فتح نموذج ثم تتتابع الأوامر حتى النهاية . المطلوب : بعد أمر فتح النموذج أن يقف تنفيذ الأوامر حتى يتم إغلاق النموذج بمعنى أن لا تظهر رسالة "Hello" حتى يتم غلق نموذج1 . Sub test() ' ' DoCmd.OpenForm "نموذج1" '-- المطلوب توقف الكود حتى يتم غلق النموذج المفتوح أعلاه نموذج1 MsgBox "Hello" ' ' ' End Sub تحياتي .

الدالة بعد التعديل : Function CountWkDay(ByVal Date1 As Long, _ ByVal Date2 As Long, _ WkDay As Byte) As Variant If Date1 <= Date2 Then Date1 = Date1 - 1 Else Date2 = Date2 - 1 End If Date1 = Fix((Date1 + (7 - WkDay)) / 7) Date2 = Fix((Date2 + (7 - WkDay)) / 7) CountWkDay = Abs(Date2 - Date1) End Function حاولت أن استخدام الخط السميك داخل الكود ولم يعمل فاضطررت للتعديل وحذف التحديد .

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

السلام عليكم شكرا لكم جميعا لتفاعلكم مع الموضوع ، الحقيقة عمل معي مع الـ XP للويندوز والأكسس وبعد مساهمة أخي العزيز ابن مسقط فأنا أتوقع أن السبب هو الأكسس وليس النظام . عموما عملت دالة لتقوم بإظهار الرسائل العربية باسم ArbMsgBox بدلا من MsgBox الأصل على أن تقوم الدالة نفسها بتغيير اتجاه الصندوق ومحاذاة النص لليمين حيث لا داعي لكتابتها أثناء طلب الرسالة . ولكــــــــــــــن .. ظهرت عندي مشكلة أن الإتجاه والمحاذاة لم تعملا وأرجح أن يكون السبب اللغة حيث لم أقم بتثبيتها مع الأوفيس . ثانيا لم يعمل التعريب أثناء جعل النموذج للـ Pop Up = On . عليه سوف يكون لي جولة أخرى مع الرسائل العربية لاحقا . تحياتي . الملفات المرفقة ArbMsgBox.zip ( 25.55ك ) عدد مرات التنزيل: 125

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

السلام عليكم أخي محمد طاهر .. هذه دالة أخرى قد تكون أسرع وخصوصا للمدد (الفترات) الطويلة وذلك لعدم حاجة الدالة لاستخدام أي تكرار loop وهي صالحة للأكسل والأكسس . هذه الدالة لحساب أي يوم من الإسبوع بين تاريخين : Function CountWkDay(ByVal Date1 As Long, _ ByVal Date2 As Long, _ WkDay As Byte) As Variant Date1 = Date1 - 1 Date1 = Fix((Date1 + (7 - WkDay)) / 7) Date2 = Fix((Date2 + (7 - WkDay)) / 7) CountWkDay = Date2 - Date1 End Function وهذه دالة لحساب الجمعة والسبت تم فيها استخدام الدالة أعلاه : Function GetFriSat(ByVal Date1 As Long, _ ByVal Date2 As Long) GetFriSat = CountWkDay(Date1, Date2, vbFriday) + _ CountWkDay(Date1, Date2, vbSaturday) End Function تحياتي .

السلام عليكم لقد قمت بتجهيز مثال لصندوق رسائل عربي وبدأت العمل به ليكون أول مشاركة لي في منتدانا القادم ولكن .. بعد البحث وجدت كود لتعريب أزرار صندوق الرسائل الأصل وحاولت جاهدا للإستفادة منه ولكن باءت كل محاولاتي بالفشل . عليه إذا تمكن أحدكم من التعديل عليه أو تشغيله بدون مشاكل سوف أقوم بالإستفادة منه بعد تكييفه ليصبح عربي 100% ، وإذا لم يمكن ذلك سوف أقوم بتكملة ما ابتدأت به وهو تصميمه من البداية . آمل منكم الآتي : 1 - المحاولة مع الكود فقد ينجح ويكفينا تعب التصميم من البداية . 2 - في حالة عدم الإستفادة من الكود أن تتفضلوا علينا باقتراحاتكم لتصميم صندوق عربي جديد . Option Compare Database Option Explicit Private m_hHook As Long Private Const IDOK = 1 Private Const IDCANCEL = 2 Private Const IDABORT = 3 Private Const IDRETRY = 4 Private Const IDIGNORE = 5 Private Const IDYES = 6 Private Const IDNO = 7 Private Const WH_CBT = 5 Private Const GWL_HINSTANCE = (-6) Private Const HCBT_ACTIVATE = 5 Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _ (ByVal hwnd As Long, ByVal nIndex As Long) As Long Private Declare Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" _ (ByVal hDlg As Long, ByVal nIDDlgItem As Long, _ ByVal lpString As String) As Long Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _ (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _ ByVal dwThreadId As Long) As Long Private Declare Function UnhookWindowsHookEx Lib "user32" _ (ByVal hHook As Long) As Long Public Sub MessageBoxH(hwndThreadOwner As Long) Dim hInstance As Long Dim hThreadId As Long hInstance = GetWindowLong(hwndThreadOwner, GWL_HINSTANCE) hThreadId = GetCurrentThreadId() m_hHook = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHookProc, hInstance, hThreadId) End Sub Private Function MsgBoxHookProc(ByVal uMsg As Long, ByVal wParam As Long, _ ByVal lParam As Long) As Long If uMsg = HCBT_ACTIVATE Then SetDlgItemText wParam, IDOK, "موافق" SetDlgItemText wParam, IDCANCEL, "إلغاء الأمر" SetDlgItemText wParam, IDABORT, "إحباط" SetDlgItemText wParam, IDRETRY, "إعادة المحاولة" SetDlgItemText wParam, IDIGNORE, "تجاهل" SetDlgItemText wParam, IDYES, "نعم" SetDlgItemText wParam, IDNO, "لا" UnhookWindowsHookEx m_hHook End If MsgBoxHookProc = False End Function ولتنفيذ الكود ضع هذا الكود في حدث عند النقر لزر button : 'هذه الإجراء مسؤول عن تعريب الأزرار MessageBoxH Me.hwnd 'بعدها مباشرة استدعاء الدالة بالطريقة المعروفة MsgBox "لقد أصبحت عناوين الأزرار باللغة العربية" & vbCrLf & "مع تحيات عامر جوز" _ , vbInformation + vbMsgBoxRtlReading + vbMsgBoxRight, "الفريق العربي للبرمجة" 'باقي الأزرار MessageBoxH Me.hwnd MsgBox "باقي الأزرار", vbYesNoCancel + vbMsgBoxRtlReading + vbMsgBoxRight MessageBoxH Me.hwnd MsgBox "باقي الأزرار", vbAbortRetryIgnore + vbMsgBoxRtlReading + vbMsgBoxRight تحياتي .