نجوم المشاركات

بارك الله فيك أستاذى الكريم سليم معادلة ممتازة اسمح لى استاذى الكريم ولإثراء الموضوع هناك معادلة أخرى يمكن استخدامها =MID($A2,COLUMNS($A$2:A$2),1) معادلة يجزأ الكلمة الى حروف.xlsx

السلام عليكم ورحمة الله تعالى وبركاته من منا يمل من كثرة استخدام الرسائل مثلى ويظل يفكر فى كل مرة كيف سيكتب الكود المناسب الان موديول واحد به الحل النهائى المرن فى التعامل مع الرسائل وحتى لا ننسي الفضل لاصحاب هذا العمل الحقيقين الاستاذ @أبو هادي >>----> تعريب الصندوق الاستاذ @ابوخليل >>----> تعريب الصندوق الاستاذ @أبو آدم >>----> تلوين محتوى الرسالة هذا المثال الذى اهديه لكم هو خلاصة دمج الاكواد المستخدمة من كل معلم من هؤلاء العظماء مع بعض التطوير البسيط الذى لا يذكـر اصلا والذى فقط يضفى المرونة فى سهولة استدعاء الكود داخل اى نموذج مع مرونة التغيير فى اضافات الرسالة او عنوان الرسالة حسب متطلبات المبرمج - ملاحظة للمرة الاولى احاول التوفيق بين الأكواد التى تعمل على كل من النواتين 64 بيت والـ 32 بيت ولا اعلم صراحة هل وفقت فى ذلك ام لا شرح سريع لمحتوى المثال المرفق اولا أكواد الموديول هذا الكود للاستاذ الجليل الاستاذ @أبو آدم '---- اللألوان -------------------------------------------------------------------------------- #If Win64 Then Declare PtrSafe Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long Declare PtrSafe Function SetSysColors Lib "user32" (ByVal nChanges As Long, lpSysColor As Long, lpColorValues As Long) As Long #Else Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long Declare Function SetSysColors Lib "user32" (ByVal nChanges As Long, lpSysColor As Long, lpColorValues As Long) As Long #End If Public DefaultColour As Long Public Const COLOR_WINDOWTEXT As Long = 8 Public Const CHANGE_INDEX As Long = 1 طريقة استخدام الكود بالاستدعاء داخل اى مكان بالبرنامج DefaultColour = GetSysColor(COLOR_WINDOWTEXT) ' تخزين لون ثيم النظام الافتراضي SetSysColors CHANGE_INDEX, COLOR_WINDOWTEXT, vbRed ' اضبط لون ثيم النظام على اللون الأحمر MsgBox "you welcome in officena forums", , "welcome" ' كود الرسالة SetSysColors CHANGE_INDEX, COLOR_WINDOWTEXT, defaultColour ' استعادة القيمة الافتراضية بعد اغلاق الرسالة الشرح تفصيلا لكل سطر بالكود DefaultColour = GetSysColor(COLOR_WINDOWTEXT) هذا السطر لحفظ تنسيق الالوان المستخدم فى ثيم الويندوز ثم SetSysColors CHANGE_INDEX, COLOR_WINDOWTEXT, vbRed هذا يغير اعدادت ثيم الويندوز لتغير لون الكتابة الى اللون الاحمر طبعا يمكن تغيير اللون كيفما تريد بتغير vbRed الى ما تريده انت ثم نكتب الرسالة داخل الكود المخصص لها مثلا MsgBox "you welcome in officena forums", , "welcome" ثم بعد عرض الرسالة العودة مرة اخرى للون المفضل لثيم الويندوز والذى اختفظنا به فى الجزء الاول من الكود SetSysColors CHANGE_INDEX, COLOR_WINDOWTEXT, DefaultColour وبهذا انتهى جزء تلوين محتوى النص للرسالة الجزء الثانى من الكود داخل الموديول والخاص بتعريب الأزرار الاستاذ @ابوخليل / الاستاذ @أبو هادي #If Win64 Then Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long Declare PtrSafe Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long #Else Declare Function GetCurrentThreadId Lib "kernel32" () As Long Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long Declare Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long 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 Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long #End If Private m_hHook As Long Const IDOK = 1 Const IDCANCEL = 2 Const IDABORT = 3 Const IDRETRY = 4 Const IDIGNORE = 5 Const IDYES = 6 Const IDNO = 7 Const IDCLOSE = 8 Const IDHELP = 9 Const WH_CBT = 5 Const GWL_HINSTANCE = (-6) Const HCBT_ACTIVATE = 5 Public Sub MessageBoxFullArabicButtons(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, "لا" SetDlgItemText wParam, IDCLOSE, "إغلاق" SetDlgItemText wParam, IDHELP, "مساعدة" UnhookWindowsHookEx m_hHook End If MsgBoxHookProc = False End Function الجزء التالى هو بناء كود عام للرسالة حتى يسهل استخدامه باستدعائه بكل سهولة فى جميع نماذج البرنامج Public Function MyMesg(Mesgtxt As String, _ Optional ByVal Buttons As VbMsgBoxStyle = vbOKOnly, _ Optional ByVal Title As String = "تطوير صندوق الرسائل العربى من منتديات اوفيسنا", _ Optional ByVal HelpFile As Variant, _ Optional ByVal Context As Variant) As VbMsgBoxResult MessageBoxFullArabicButtons Application.hWndAccessApp MyMesg = MsgBox(Mesgtxt, Buttons + vbMsgBoxRtlReading + vbMsgBoxRight + vbDefaultButton1, Title) End Function نلاحظ الاتى بوجه عام هذا الكود تم تصميمه على ان يكوم اقتراضيا بهذا الشكل الرسالة بسيطة تحتوى على زر امر واحد Buttons As VbMsgBoxStyle = vbOKOnly عنوان الرسالة الإفتراضى Title As String = "تطوير صندوق الرسائل العربى من منتديات اوفيسنا" الجزء من الكود هذا MessageBoxFullArabicButtons Application.hWndAccessApp الذى يستدعى تعريب الازرار السطر الاخير البناء الطيعى لتكوين كود الرسالة بالاضافات التى يفضلها المبرمج MyMesg = MsgBox(Mesgtxt, Buttons + vbMsgBoxRtlReading + vbMsgBoxRight + vbDefaultButton1, Title) طريقة استخدام الكود بالاستدعاء داخل اى مكان بالبرنامج MyMesg "منتديات أوفيسنا ترحب بكم" لتغيير العنوان الافتراضى MyMesg "منتديات أوفيسنا ترحب بكم",,"العنوان الجديد كما تريد" استخدام الاضافات لتغيير الازرار مثلا MyMesg "هل أعجبتك هذه الترجمة و التعديلات والأفكار؟", vbYesNo مع عنوان مخصص MyMesg "هل أعجبتك هذه الترجمة و التعديلات والأفكار؟", vbYesNo,"عنوان جديد" والان وصلنا الى نهاية الموضوع اسأل الله تعالى ان يرزق اساذتنا العظماء الذين كان لهم الفضل فى هذا الموضوع البركة فى العمر والعلم والرزق والاهل والولد اللهم اغفر لهم ولوالديهم واللهم احسن اليهم كما احسنوا هم الينا اللهم تقبل اعمالهم يارب العالمين فى موازين اعمالهم وضاعف حسناتهم و الاجر اضعافا مضاعفة يارب العالمين اللهم ارفع درجاتهم فى أعلى درجات الجنان ودرجاتهم والديهم يارب العالمين امين امين امين Full Arabic Message Box.accdb Full Arabic Message Box.mdb

تفضل Private Sub id_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyF6 Then SendKeys "^'", True End If End Sub db2.mdb

وعليكم السلام-تفضل تظليل تلقائى.xlsx

بارك الله فيك وجزاك الله كل خير

الاخ الكريم /سليم حاصبيا الموقر والاخ الكريم / Ali Mohamed Ali الموقر جزاكم الله خير وبارك الله فيكم وفي ابدانكم واولادكم

لأنك لم تقم أستاذ محمد بعمل ما أبلغتك به فالملف يعمل معى بكل كفاءة فيبدو انك اخذت الكود فقط وقمت بلصقه ولكنك لم تنظر وتنتبه الى الملف

بعد اذن الاساتذة كود على السريع Private Sub TextBox1_Change() Application.EnableEvents = False If TextBox1.TextLength > 12 Then MsgBox "Too long Expression" TextBox1 = vbNullString End If Application.EnableEvents = True End Sub

وعليكم السلام اكتب فى خاصيه Maxlenght رقم 12 مع وجود هذا الكود داخل التكست بوكس حتى لا يقبل سوى ارقام Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) If KeyAscii > Asc("9") Or KeyAscii < Asc("0") Then If KeyAscii = Asc("-") Then If InStr(1, Me.TextBox1.Text, "-") > 0 Or _ Me.TextBox1.SelStart > 0 Then KeyAscii = 0 ElseIf KeyAscii = Asc(".") Then If InStr(1, Me.TextBox1.Text, ".") > 0 Then KeyAscii = 0 Else KeyAscii = 0 End If End If End Sub أو فقط هذا الكود لو حابب تكتب أرقام وحروف مثلا Private Sub TextBox1_Change() MaxLength = 12 End Sub 1.xls

ربما كان المطلوب Salim_99.xlsx

هيا انظر هذا الاستعلام النهائي المطلوب بعدما تعرفت على الخطوات ...... استعلام تحديث الصف الدراسي.accdb

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

أخي الكريم قبل التحديث وللعلم فقط انظر الاستعلام في المرفق وحاول أكمال بقية الصفوف ...... للتعلم فقط .... استعلام تحديث الصف الدراسي.accdb

أخى الكريم حاول تفهم وتدرس أكواد الفورم جيدا وتتبع خطواته وتقرأ وترى فيديوهات عن هذه المواضيع من الأكواد وهذان ملفان وورد بهما بعض الأكواد البسيطة والهامة جزاك الله كل خير VBA CODES.docx مجموعة أكواد vba excel.doc

تفضل أخى الكريم لك ما طلبت التلقيح3.xlsm

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

وعليكم السلام ممكن تجرب هذا التلقيح2.xlsm

أخى الكريم قم بنسخ الكود فى اى ملف تريد وبعد ذلك انسخ هذه المعادلة فى الخلية التى تريدها =IFERROR( "فقط" & " " & Ar_WriteDownNumber(B1,"طن","كيلو",1000) & " " & "لاغير","") سيعمل معك الكود بكل كفاءة جزاك الله كل خير

هذا فيديو لأستاذنا الكبير ياسر خليل للتخلص من هذه الرسالة أما بالنسبة للجزئية الأولى من السؤال وهى كتابة الرقم بين علامتين ## بارك الله فيك

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

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

وعليكم السلام اخى الكريم لقد تم الحل من قبل أستاذنا الكبير زيزو العجوز له منا كل السلام والإحترام والمحبة ‏‏2017شيت مدرستى - الصف الخامس- - نسخة.rar

تفضل اخى الكريم Book1.xlsm

ممتاز بارك الله فيك استاذ سليم وجعله فى ميزان حسناتك وزيادة فى اثراء الموضوع بعد اذن حضرتك طبعا استاذ سليم ,يمكن استخدام هذا الكود Sub NameSplit() Dim var As Variant Dim rw As Long With Worksheets("Salim") For rw = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row If CBool(Len(.Cells(rw, "A").Value2)) Then var = Split(.Cells(rw, "A").Value2, Chr(32)) .Cells(rw, "B").Resize(1, UBound(var) + 1) = var End If Next rw End With End Sub

تفضل 🙂 . . جعفر 1068.Database1 (1).accdb.zip

فورم بحث متن الأربعين النووية من الأحاديث الصحيحة النبوية الفيديو الصور الملف  فورم بحث متن الأربعين النووية من الأحاديث الصحيحة النبوية.rar

وعليكم السلام 🙂 يمكن عمله بصيغة رقم: وصيغة نص 🙂 جعفر

الاستاذ : عبداللطيف اشكرك علي الرد والاهتمام ولكن الفيديو يوضح عمل زر f لفتح فورم معين انا اريد كيفية نسخ حقل من الحقل الاعلي له في نموذج ما كما يعمل الاختصار ctrl+' آمل أن يكون الطلب واضح مع تحياتي وتقديري

دالة مع الملف يحتوى على الكود Option Explicit ' ### Provided By Nart Lebzo For www.officena.net ### Public Function RowNum(FRM As Form) As Variant On Error GoTo Err_RowNum With FRM.RecordsetClone .Bookmark = FRM.Bookmark RowNum = .AbsolutePosition + 1 End With Exit_RowNum: Exit Function Err_RowNum: If Err.Number <> 3021& Then 'Ignore "No bookmark" at new row. Debug.Print "RowNum() error " & Err.Number & " - " & Err.Description End If RowNum = Null Resume Exit_RowNum End Function ثم عنصر التحكم الذى اشرت اليه واضح من الكود استاذنا اللى كتبه

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

تفضل أخى الكريم الكود لأحد عمالقة المنتدى Database111.rar

تفضل لك ما طلبت -ومجرب كمان على الطابعة طباعة الفورم بدون ازرار.xlsm

تفضل New_Microsoft_Excel_Worksheet.xlsx

جزاك الله كل خير وبارك الله فيك

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

تفضل كرت تشغيل.xlsx

تفضل لقد تم الحل من قبل أستاذنا الكبير زيزو العجوز له منا كل الحب والإحترام والفخر فتح رابط ويب.xlsm

تفضل اخى الكريم فورم بحث برقم الجلوس وبه إضافة وتعديل وحذف .xlsm

اجعل المعادلة هكذا: =IF($E6="","",IF($E6<=$E$2,"لايستحق","يستحق"))

وعليكم السلام من الأفضل أخى الكريم ارسال ملف للعمل عليه وشرح كل ماتريد عمله عليه

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

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

تفضل جرب هذا Load Picture On UserForm Using Dialog & Insert Image To Worksheet YasserKhalil.rar وهذا ملف اخر إدراج الصورة.xlsm

اخي الكريم راجع هذا الرابط قد يفيدك https://support.microsoft.com/ar-sa/help/2581301/acc2010-you-receive-an-error-in-microsoft-access-using-the-built-in-wi

اذا كان ما فهمته صحيحا استخدم select case

ابحث في المنتدى عن برامج وطرق الحماية فهي تعج بهذه الطرق ...

Dim i As Integer DoCmd.GoToRecord , , acFirst For i = 1 To Me.countRec hafez = salary * 0.2 kest = 20 total = [salary] + [hafez] - [kest] DoCmd.GoToRecord , , acNext Next

أخي الكريم يمكن استخدام قاعدة For , Next للمعادلة المطلوبة لجميع السجلات

السلام عليكم ورحمة الله وبركاته مبارك عليكم العشر المباركة سؤالي كيف يمكن اضافة كود أو عبارة في سطر معين من المديول بطريقة برمجية ....... في جزء الكود المرفق هو كود لاضافة كود اضافة قتح نموذج معين الى اكواد النموذج برمجيا .... اريد التعديل عليه ليصبح للمديول ... شاكرا لكم تعاونكم بارك الله فيكم AA.DoCmd.OpenForm "frmSn", acDesign Set MM = AA.Forms("frmSn").Module MM.InsertLines 17, " DoCmd.OpenForm " & Chr(34) & GG & Chr(34)

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