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

السلام عليكم 🙂 ولكي يكتمل الدرس ، وبدل ان نحفظ ونستخدم ارقام لا نعرفها ، اليك قائمة اسماء جميع الكائنات (وبالمسميات اللي نعرفها ، مضافا لها حرفي ac)، من مساعد الاكسس : . وعليه يصبح الكود : Dim frm As Form Dim fc As Control Set frm = Me For Each fc In frm.Controls If fc.ControlType = acCommandButton Then Me.combo1.AddItem (fc.Name) End If Next fc Set frm = Nothing جعفر

الفضل لله أولا ثم لك أنت أيضا لأنك أتممت الإجابة و هذه طريقة ثانية لإضافة القيمة لقائمة منسدلة Dim frm As Form Dim fc As Control Set frm = Me For Each fc In frm.Controls If fc.ControlType = 104 Then Me.combo1.AddItem (fc.Name) End If Next fc Set frm = Nothing

تفضل ----------->>> moh-21.rar

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

الحمد للع الذى تتم بنعمته الصالحات اتفضل فكرة رقم 2 1817242942_New2.accdb

السلام عليكم ورحمة الله ضع المعادلة التالية قى الخلية "" =COUNTIFS($B$3:$B$5000;"السادس ";$C$3:$C$5000;$G3;$D$3:$D$5000;"أ") اما المعادلة التالية فضعها فى الخلية "" =COUNTIFS($B$3:$B$5000;"السادس ";$C$3:$C$5000;$G3;$D$3:$D$5000;"ب") ثم اسحب المعادلتين الى اخر خلية تريدها قم بتغيير اسم الصف فى كل جدول هذا و بالله التوفيق عفوا الخلية الاولى " H3 " و الخلية الثانية " I3 " حساب أعداد الطلاب حسب ثلاث قيم.xlsx

السلام عليكم 🙂 هذا المنتدى للتبادل العلمي ، حتى يستفيد منه الجميع ، وليس صاحب الموضوع / السؤال فقط 🙂 فيا ريت ان نضع الاجابة بالتفصيل في الرد (سواء الخطوات او الكود او صور من شاشة البرنامج) ، ولا نتوقف عند ارفاق المرفق الذي به الرد / الجواب ، والسبب هو ، حتى يستطيع الجميع رؤية الرد ومعرفته مباشرة ، دون اللجوء الى انزال المرفق وفهمه 🙂 نعم ، هذا عبء إضافي ، ولكن نتائجه ستكون مثمرة ان شاء الله 🙂 وتذكروا ، هذا مجرد طلب ورجاء ، وليس اجباري 🙂 شكرا جزيلا 🙂 جعفر

جزااااااااااااااااااااااااااااااااااكم الله خيــــــــــــــــــــــــــــــــــــــــــــــرا نعم القلوب عند بعضها احبكم فى الله

يبدو أننا كنا نكتب الرد في وقت واحد 😀

تم حل المشكلة بفضل الله تعالى اخى الحبيب و استاذى الجليل ومعلمى القدير الاستاذ @أبو عبدالله الحلوانى كان الخطأ فى هذا السطر Set chkDb = OpenDatabase(Application.CurrentProject.Path & "\Btbl.accdb") وتم التعديل على الكود كالاتى ونجحت العملية بفضل الله تعالى Set chkDb = OpenDatabase(Application.CurrentProject.Path & "\Btbl.accdb", False, False, ";PWD=0")

فقط أضف معلومات الاتصال بهذا الشكل Set chkDb = OpenDatabase(Application.CurrentProject.Path & "\Btbl.accdb",,,"MS Access;PWD=0")

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

اخ محمد اخ محمد انظر الرابط التالي سيفيدك وستتمكن من التعديل بنفسك إن شاء الله

الكود الصحيح Private Sub Yh_TextFind_Change() Dim MySh As Worksheet Dim LastRow As Integer Dim M As String Dim A As Range, F% Set MySh = Sheets("ورقة1") Yh_ListFind.Clear If Yh_TextFind.Text = "" Then Exit Sub M = Yh_TextFind.Text LastRow = MySh.Cells(Rows.Count, 1).End(3).Row Set A = MySh.Range("F3:F" & LastRow).Find(M, LOOKAT:=1) If A Is Nothing Then Exit Sub F = A.Row Do With Yh_ListFind .AddItem For K = 0 To 9 .List(.ListCount - 1, K) = _ MySh.Cells(A.Row, K + 1) Next K End With Set A = MySh.Range("F3:F" & LastRow).FindNext(A) Loop While A.Row <> F End Sub YESS_w.xlsm

اخي حسام ، انا كنت استخدم هذه الطريقة ، الى ان صادفت مشكلة تشغيل البرنامج بين اكسس تنصيب انجليزي ، وآخر تنصيب عربي ، وظهرت القائمة كلها كسطر واحد !! لذلك انصحك ان تستخدم طريقة الاستاذ صالح ، والتي تعمل على جميع الانظمة: Me.combo1.AddItem (fc.Name) جعفر

تفضل --------->>>>> يوميات.accdb

السلام عليكم قم بتغيير me.snabdo الى Animal_ID بالتوفيق

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

أضافة ماكرو جديد (نفس القديم مع زيادة ما في هذه الصورة) و زر جديد له More Options الملف اصبج بحجم كبير جداً (حوالي 9 ميغا لا يطاق) ما كفاية بقى بحث بهذا الموضوع الذي ضجرنا منه رغبة في مزاجية رب عملك (كل ساعة يلون) سوف يتم اغلاق الموضوع مباشرة بعد الحصول على رد لهذه الاجابة Option Explicit Sub get_By_Color() Dim D As Worksheet Dim Sh As Worksheet Dim Ar(), Min_date As Date, Max_date As Date Dim K%, t%, Arr_sh() Dim My_ro%, m%, ro%, my_sum#, x% Dim Sum_pos#, Sum_Neg# Dim Part_sum# K = 2 Set D = Sheets("DataReport") D.Rows.Hidden = False If D.Range("A3").CurrentRegion.Rows.Count > 1 Then D.Range("A3").CurrentRegion.Offset(1). _ Resize(D.Range("A3").CurrentRegion.Rows.Count - 1).Clear End If If Not IsDate(D.Range("J2")) Or _ Not IsDate(D.Range("K2")) Then Exit Sub Min_date = Application.Min(D.Range("J2:K2")) Max_date = Application.Max(D.Range("J2:K2")) Ar = Array("E", "F", "G", "H", "I", "J") 'For Each Sh In Sheets Select Case UCase(D.Range("N1")) Case 3, 10, 55 For Each Sh In Sheets If Sh.Tab.ColorIndex = D.Range("N1") Then ReDim Preserve Arr_sh(m) Arr_sh(m) = Sh.Name: m = m + 1 End If Next Case "R_B" For Each Sh In Sheets If Sh.Tab.ColorIndex = 3 _ Or Sh.Tab.ColorIndex = 55 Then ReDim Preserve Arr_sh(m) Arr_sh(m) = Sh.Name: m = m + 1 End If Next Case "R_G" For Each Sh In Sheets If Sh.Tab.ColorIndex = 3 _ Or Sh.Tab.ColorIndex = 10 Then ReDim Preserve Arr_sh(m) Arr_sh(m) = Sh.Name: m = m + 1 End If Next Case "G_B" For Each Sh In Sheets If Sh.Tab.ColorIndex = 10 _ Or Sh.Tab.ColorIndex = 55 Then ReDim Preserve Arr_sh(m) Arr_sh(m) = Sh.Name: m = m + 1 End If Next Case Else For Each Sh In Sheets If Sh.Tab.ColorIndex = 3 _ Or Sh.Tab.ColorIndex = 10 _ Or Sh.Tab.ColorIndex = 55 Then ReDim Preserve Arr_sh(m) Arr_sh(m) = Sh.Name: m = m + 1 End If Next End Select If m = 0 Then Exit Sub For m = LBound(Arr_sh) To UBound(Arr_sh) D.Cells(K, 1) = Arr_sh(m) D.Cells(K + 1, 1) = "Total " & D.Cells(12, "J") D.Cells(K + 1, 1).Resize(, UBound(Ar) + 2).Interior.ColorIndex = 20 K = K + 2 Next m My_ro = 3 For m = LBound(Arr_sh) To UBound(Arr_sh) Set Sh = Sheets(Arr_sh(m)) Sh.Range("A5:J20000").Interior.ColorIndex = xlNone ro = Sh.Cells(Rows.Count, 1).End(3).Row For K = LBound(Ar) To UBound(Ar) t = K + 2 For x = 5 To ro If Sh.Cells(x, 1) <= Max_date _ And Sh.Cells(x, 1) >= Min_date Then Sh.Cells(x, 1).Interior.ColorIndex = 40 If Val(Sh.Cells(x, Ar(K))) <> 0 Then my_sum = my_sum + Sh.Cells(x, Ar(K)) '+++++++++++++++++++++++++++++ If Val(Sh.Cells(x, Ar(K))) <= 0 Then Sum_Neg = Sum_Neg + Val(Sh.Cells(x, Ar(K))) Sh.Cells(x, Ar(K)).Interior.ColorIndex = 6 Else Sum_pos = Sum_pos + Val(Sh.Cells(x, Ar(K))) Sh.Cells(x, Ar(K)).Interior.ColorIndex = 35 End If '++++++++++++++++++++++++++ Part_sum = Round((Sum_pos * 0.85) + Sum_Neg, 2) End If '<>0 End If Next x Select Case D.Cells(12, "J") Case "Positive" Select Case D.Range("N1") Case 3: Sum_pos = 0.1475 * Sum_pos Case 55: Sum_pos = 0.705 * Sum_pos Case Else: Sum_pos = Sum_pos End Select D.Cells(My_ro, t) = Sum_pos Case "Nagative" D.Cells(My_ro, t) = Sum_Neg Case "Part" D.Cells(My_ro, t) = Part_sum Case Else D.Cells(My_ro, t) = my_sum End Select my_sum = 0: Sum_pos = 0: Sum_Neg = 0: Part_sum = 0 Next K My_ro = My_ro + 2 Next m D.Cells(My_ro, 1) = "Sum Of All" Rem D.Cells(My_ro - 1, 2).Resize(, UBound(Ar) + 1) = Ar With D.Cells(My_ro - 1, 2).Resize(, 6) .Value = D.Cells(1, 2).Resize(, 6).Value .Interior.Color = vbBlue .Font.Color = vbWhite End With D.Cells(My_ro, 2).Resize(, UBound(Ar) + 1).Formula = _ "=Sum(B3:B" & My_ro - 2 & ")" D.Cells(My_ro, 1).Resize(, UBound(Ar) + 2).Interior.ColorIndex = 6 If D.Range("A3").CurrentRegion.Rows.Count > 1 Then With D.Range("A3").CurrentRegion.Offset(1). _ Resize(D.Range("A3").CurrentRegion.Rows.Count - 1) .Borders.LineStyle = 1: .Font.Size = 14 .Font.Bold = True: .HorizontalAlignment = xlCenter .Value = .Value End With End If For m = My_ro - 2 To 3 Step -1 If D.Cells(m, 1) Like "Total*" And _ Application.Sum(D.Cells(m, 2).Resize(, 6)) = 0 Then D.Range(Cells(m, 1), Cells(m - 1, 1)).EntireRow.Hidden = True End If Next End Sub الملف مرفق Yara_More_Optione.xlsm

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

بالخدمة استاذ Ahmed.IQ والفضل لاستاذ صالح على هذا الكود الجميل

السلام عليكم من رخصة استاذي العزيز صالح حمادي تفضل استاذ Ahmed.IQ التعديل علما ان التعديل جرى على نفس كود استاذ صالح Dim frm As Form Dim fc As Control Dim RowData As String Set frm = Me RowData = "" For Each fc In frm.Controls If fc.ControlType = 104 Then RowData = RowData & "," & fc.Name End If Next fc Me.Comb1.RowSource = Right(RowData, Len(RowData) - 1) Set frm = Nothing ملاحظة : Row Source Type = Value List

السلام عليكم و رحمة الله تعالى و بركاته استخدم الكود التالي سوف يعطيك أسماء جميع الأزرار Dim frm As Form Dim fc As Control Set frm = Me For Each fc In frm.Controls If fc.ControlType = 104 Then MsgBox (fc.Name) End If Next fc Set frm = Nothing

بالخدمة استاذ AhmedEmam بالنسبة للالوان ضع الكود التالي بدل كود خلفية النموذج Forms(str).FormHeader.BackColor = vbRed Forms(str).Detail.BackColor = vbBlue Forms(str).FormFooter.BackColor = vbGreen

فكرة بسرعة New.accdb

اكتب هذا الحدث --------------->>>>> If ((Eval("DLookUp(""[no]and[name_1]and[date_1]"",""[Table1]"",""[no] = Form.[no] and [name_1] = Form.[name_1]and [date_1] = Form.[date_1] "") Is Not Null"))) Then MsgBox "عـفواً ، تم تسجيـل هذا الإسم الكامل بالفعل", vbMsgBoxRtlReading, "منع تكرار" DoCmd.RunCommand acCmdDelete End If

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

وعليكم السلام - تفضل اخى الكريم يمكنك عمل ذلك بهذه المعادلة ( معادلة مصفوفة) Ctrl+Shift+Enter =IF(COUNTIF($A$3:$A3,$A3)>1,"",MODE(IF($A$3:$A$900=$A3,$F$3:$F$900))) mode fun1.xlsx

السلام عليكم ورحمة الله وبركاتة هذا مثال يتم من خلاله ربط الجداول برمجيا بدون تدخل من المستخدم عند فتح قاعدة الواجهات kaser906 يتم ربط الجداول بقاعدة جداول kaser906_be والقاعدة الثانية kasr9062 وكلتا القاعدتين مغفلتين برقم سري 1234 ضع المجلد في أي مكان او غير أسم المجلد وفتح قاعدة بيانات الواجهات kaser906 ستجد أن ربط الجداول تم بدون تدخل منك ::بالتوفيق للجميع :: TablLinkind.rar

اخي الكريم شاهر السلام عليكم ورحمة الله وبركاته يوجد عدة حلول لهذه المشكلة وخاصة مع ويندوز XP وسأقوم بشرحها اولا : الطريقة اليدويه . عن طريق تعطيل مدير المهام Disable Task Manager حسب الطريقة التالية : 1. ابدأ 2. تشغيل 3. اكتب التالي gpedit.msc ثم موافق 4. سيظهر لك لوحة Group Policy 5. ستجد اسفل نهج الكمبيوتر المحلي اختيارين هما *. تكوين الكمبيوتر *. تكوين المستخدم اختر تكوين المستخدم واختر منها قوالب الادارة ثم اختر منها System ثم اختر منها Ctrl+Alt+Del Options ستظهر لك في الجهة المقابلة اربعة اختيارات اختر منها الاولى وهي Remove Task Manager . وقم بالضغط عليها بالماوس الايمن واختر خصائص . سيظهر لك ثلاثة اختيارات *. غير ممكن *. ممكن *. معطل اختر منها رقم 2 ( ممكن ) ثم موافق وقم بإغلاق كل شيء . 6. الان جرب استخدام الضغط على المفاتيح Ctrl+Alt+Del دفعة واحدة لن تستطيع الدخول على مدير المهام وهذا هو المطلوب . الطريقة الثانية عن طريق الريجستري الخاص بالويندوز xp تحذير : ان اي خلل او عبث في ملف الريجستري سيوقف نظام الويندوز نهائيا ولن تستطيع تشغيلها الا عن طريق اعادة تحميلها من جديد . كما ترى اخي شاهر وجميع الاخوان انني لم ارغب في التطرق لهذا الموضوع الا لفئة قليلة جدا من محترفي الويندوز والاكسيس والذين يعرفون كيفية التعامل مع اخطاء الريجستري الخاص بالويندوز والسبب انه في حال تعطل الريجستري فلا يوجد لها حلول يمكن تقديمها لك لان ملف الريجستري يوجد لديك انت فقط ولكل جهاز اعداداته الخاصه به مع ان هناك برامج تقوم بعملية الاصلاح ولهذا نتجنب العبث بهذا الملف حتى لا يتم التدمير الكامل للويندوز وفقد كافة البرامج الخاصة بك . سأورد لك بعض الامثلة البسيطة انت وجميع الاخوان تستطيعون تجربتها بحيث لا تأثر على ملف الريجستري وتستطيعون حذفها برمجيا ايضا عن طريق الاكسيس. الدالة () SaveSetting هذه الدالة تستخدم مع برنامج الاكسيس وتقوم بكتابة وتخزين بعض القيم في محرر الريجستري الخاص بالويندوز . مثال عملي : سنقوم بإدراج الكلمات الخاصة سواء عربية او انجليزية داخل محرر الريجستري بواسطة برنامج الاكسيس حسب الكود التالي : 1. انشئ زر امر على نموذج ومن ثم اختر حدث عند النقر وضع هذا الكود SaveSetting appname := "officena", section := "zahrah", _ key := "za", setting :=1 الان اغلق الاكسيس ومن ثم اذهب الى محرر الريجستري حسب الطريقة التالية 1. ابدأ 2. تشغيل واكتب في المستطيل regedit 3. سيظهر لك محرر الريجستري انتقل الى تحرير واختر بحث 4. اكتب officena ثم موافق 5. سيقوم المحرر بالبحث عن هذه القيمه الجديده 6. اضغط من لوحة المفاتيح F3 حتى تظهر لك القيمه officena وتحتها القيمة ZAHRAH ومقابلها ZA وقيمتها 1 الان نرغب في استدعاء هذه القيمه لاستدعاء هذه الدالة نستخدم الدالة ()GetSetting حسب الكود GetSetting appname := "officena", section := "zahrah", _ key := "za", setting :=1 ولالغاء هذه القيمه نستخدم الدالة DeleteSetting حسب الكود التالي DeleteSetting "officena", "zahrah" يفضل وضع كل امر في زر امر خاص به لمشاهدة النتيجه في محرر الريجستري . كمت رأيتم انه يمكن كتابة قيم وتحريرها وحذفها من خلال الكود في الاكسيس . الان سوف نقوم بالبحث عن مدير المهام Task Manager في الريجستري بالطريقة العادية . الان اغلق الاكسيس ومن ثم اذهب الى محرر الريجستري حسب الطريقة التالية 1. ابدأ 2. تشغيل واكتب في المستطيل regedit 3. سيظهر لك محرر الريجستري انتقل الى تحرير واختر بحث 4. اكتب DisableTaskMgr ثم موافق 5. سيقوم المحرر بالبحث عن هذه القيمه الجديده 6. اضغط من لوحة المفاتيح F3 حتى تظهر لك القيمه وستظهر هذه القيمة في HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System بعد ان عرفنا موقعها في محرر الريجستري نرغب في تمكينها او تعطيلها من خلال الكود في الاكسيس . تحذير : ان اي خلل في هذه العملية سيوقف نظام الويندوز اذا لم تكن لديك الخلفية القوية عن كيفية التعامل مع محرر الريجستري فدع العبث به وقم بإستخدام الطريقة اليدوية . SaveSetting appname := "HKEY_CURRENT_USER", section := "Software\Microsoft\Windows\CurrentVersion\Policies\System", _ key := "DisableTaskMgr", setting :=1 ملاحظة القيمة 0 ( صفر ) تمكين القيمة 1 ( واحد ) عدم التمكين الان اخرج من الريجستري وقم بعملية اعادة تشغيل الويندوز لتفعيل القيمة المدرجة الجديده لإيقاف هذه العملية وتمكين مدير المهام مره اخرى قم بوضع الكود التالي في زر امر SaveSetting appname := "HKEY_CURRENT_USER", section := "Software\Microsoft\Windows\CurrentVersion\Policies\System", _ key := "DisableTaskMgr", setting :=0 وبهذا نكون قد انتهينا من هذه المشكلة برمجيا بواسطة الاكسيس اختكم زهره

الطريقة الثانية لتعطيل مفاتيح لوحة المفاتيح كما لاحظتم اعزائي الكرام من الطريقة الاولى انه تم استخدام رقم المفتاح ورقم الشفت الخاص به . اما في هذه الطريقة التي نحن بصدد شرحها فتختلف قليلا لاننا سوف نستخدم اسم المفتاح مباشرة في الكود والان دعونا نتعرف على اسماء المفاتيح وكيفية استخدامها مفتاح Control vbKeyControl مفتاح Alt vbkeymenu مفتاح الادخال Enter vbKeyReturn مفتاح Back Space vbKeyBack مفتاح Tab vbKeyTab مفتاح Shift vbKeyShift مفتاح Caps Lock vbKeyCapital مفتاح Esc vbKeyEscape مفتاح Space Bar vbKeySpace مفتاح Page Up vbKeyPageUp مفتاح Page Down vbKeyPageDown مفتاح End vbKeyEnd مفتاح Home vbKeyHome مفتاح Left arrow vbKeyLeft مفتاح Up arrow vbKeyUp مفتاح Right Arrow vbKeyRight مفتاح Down Arrow vbKeyDown مفتاح Print Screen vbKeyPrint مفتاح Pause vbKeyPause مفتاح Insert vbKeyInsert مفتاح Delete vbKeyDelete مفتاح Help vbKeyHelp مفتاح Numlock vbKeyNumlock مفتاح F1 vbKeyF1 مفتاح F2 vbKeyF2 مفتاح F3 vbKeyF3 مفتاح F4 vbKeyF4 مفتاح F5 vbKeyF5 مفتاح F6 vbKeyF6 مفتاح F7 vbKeyF7 مفتاح F8 vbKeyF8 مفتاح F9 vbKeyF9 مفتاح F10 vbKeyF10 مفتاح F11 vbKeyF11 مفتاح F12 vbKeyF12 مفتاح A vbKeya ينطبق هذا على مفاتيح جميع الاحرف حتى مفتاح Z vbKeyz مفاتيح الارقام التي في الجهة اليمنى من لوحة المفاتيح وينطبق عليها ما ينطبق على مفتاح الرقم صفر vbKey0 vbKey1 vbKey2 vbKey3 vbKey4 vbKey5 vbKey6 vbKey7 vbKey8 vbKey9 طريقة الاستخدام هذه الطريقة لا تحتاج الى مفتاح تغيير ( shift ) وانما يوضع فقط اسم المفتاح ومثال ذلك على المفاتيح Control و Alt و Delete ملاحظة : هذا الكود يعمل مع ويندوز 98 و ME و 2000 اما ويندوز XP فالطريقة تختلف وسنوردها في الطريقة الثالثة . Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) Dim CTRL_1 As Boolean Dim CTRL_2 As Boolean Dim CTRL_3 As Boolean CTRL_1 = vbKeyControl CTRL_2 = vbKeyMenu CTRL_3 = vbKeyDelete On Error Resume Next Select Case KeyCode Case vbKeyControl CTRL_1 = True Case vbKeyMenu CTRL_2 = True Case vbKeyDelete CTRL_3 = True End Select If CTRL_1 And CTRL_2 And CTRL_3 Then CTRL_1 = False CTRL_2 = False CTRL_3 = False End If End Sub وهذا مثال مرفق Disable_Key_In_Form.rar

اعزائي الكرام جميعا اخي ابو شاهر السلام عليكم ورحمة الله وبركاته سأورد لكم ثلاث طرق للحل تستطيعون تطبيقها لحل هذه المشكلة اما الطريقتين الاولى والثانية فهي سهلة وسأقوم بشرحها والتطبيق عليها بأمثلة اما الطريقة الثالثة فهي متقدمة جدا وتحتاج الى ذوي خبره عالية في برنامج الاكسيس وفي نفس الوقت خطره لمن لا يعرف طريقة تطبيقها وسأوردها بعد ان نحترف الطريقتين الاولى والثانية وأعلم ان الجميع يرغب في معرفة الطريقة الثالثة وعموما هي ( اعطاء قيم من خلال برنامج الاكسيس الى محرر الريجستري الخاص بالويندوز ) ولهذا اقول انها متقدمة جدا وخطره في نفس الوقت لمن لا يعرف الطريقة لان اي خطأ في كتابة الكود وارساله للريجستري سيؤدي مباشرة الى توقف الويندوز مباشرة لهذا سندعها في الوقت الراهن ونبدأ بشرح الطريقتين الاولى والثانية . الطريقة الاولى : كما يعلم الجميع ان اي مفتاح في لوحة المفاتيح Keyboard يحمل رقم خاص به ( KeyCode ) ورقم تغيير ( ShiftCode ) دعونا نرى على سبيل المثال مفتاحي PageUP و PageDown فلهم القيم التالية : PageUP رقم المفتاح 33 رقم الشفت 0 PageDown رقم المفتاح 34 رقم الشفت 0 وطريقة استخدامها مع برنامج الاكسيس سهلة جدا من خلال اختيار حدث عند ضغط المفتاح للاسفل واختيار مفتاح العرض التمهيدي على نعم KeyPreview: Yes كالتالي : Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) Select Case KeyCode Case 33, 34 KeyCode = 0 End Select End Sub كما نرى من خلال الكود ان الارقام 33 و 34 هي ارقام محجوزه لمفتاحي الصفحة لأعلى والصفحة لأسفل ورقم الشفت الخاص بهما هو صفر ومهمة رقم الشفت هو تعطيل المفتاح عن العمل لحظة الضغط عليه وهذا ينطبق على بقية مفاتيح لوحة المفاتيح . ستجد مثال يمكن الاستفادة منه في معرفة رقم اي مفتاح على لوحة المفاتيح كل ما عليك هو الضغط على المفتاح وسيظهر لك مباشرة رقم المفتاح ورقم الشفت الخاص به ومن ثم تستطيع استخدام الكود السابق لايقاف عمل المفتاح . بعض من ارقام لوحة المفاتيح : مفتاح Shift رقم المفتاح 16 رقم الشفت 1 مفتاح Control رقم المفتاح 17 رقم الشفت 1 مفتاح Alt رقم المفتاح 18 رقم الشفت 4 مفتاح Win رقم المفتاح 91 رقم الشفت 0 مفتاح Delete رقم المفتاح 46 رقم الشفت 0 مفتاح الحرف D رقم المفتاح 68 رقم الشفت 0 مفتاح F1 رقم المفتاح 112 رقم الشفت 0 مفتاح F2 رقم المفتاح 113 رقم الشفت 0 مفتاح F3 رقم المفتاح 114 رقم الشفت 0 مفتاح F4 رقم المفتاح 115 رقم الشفت 0 مفتاح F5 رقم المفتاح 116 رقم الشفت 0 مفتاح F6 رقم المفتاح 117 رقم الشفت 0 مفتاح F7 رقم المفتاح 118 رقم الشفت 0 مفتاح الهروب Esc رقم المفتاح 27 رقم الشفت 0 تستطيعون اكمال الباقي واستخراج بقية المفاتيح بواسطة المثال المرفق . تطبيق عملي على استخدام تعطيل مفتاح Home Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) Select Case KeyCode Case 36 KeyCode = 0 End Select End Sub تطبيق عملي مع مثال مرفق على تعطيل عدة مفاتيح دفعة واحدة ( مفاتيح المساعدة ) من F1 الى F12 لهم نفس رقم الشفت Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) Select Case KeyCode Case 112,113,114,115,116,117,118,119,120,121,122,123 KeyCode = 0 End Select End Sub تطبيق عملي على تعطيل عدة مفاتيح دفعة واحدة لهم ارقام شفت مختلفه مفتاح Esc ومفتاح Shift ومفتاح Alt Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) Select Case KeyCode Case 27 KeyCode = 0 Case 16 KeyCode = 1 Case 18 KeyCode = 4 End Select End Sub نلاحظ من الاكواد السابقة انه اذا كان مفتاح التغيير ( الشفت ) لمجموعة مفتاح يحمل نفس القيمه فيكتفى بوضعه لمرة واحده فقط كما في كود تعطيل مفاتيح المساعدة F1 - F12 واذا اختلف مفتاح التغيير ( الشفت ) للمفاتيح فيوضع كل مفتاح على حده كما في الكود الاخير . لا تنسى اختيار مفتاح العرض التمهيدي ووضعه على نعم KeyPreview: Yes تابع معنا الطريقة الثانية لتعطيل مفاتيح لوحة المفتايح اختكم زهره KeyCode.rar NoHelp.rar