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

قبل فتح التطبيق يتم فقط اضافة ملفات لتنسيقات الصوت والفيديو المختلفة داخل المجلد المرفق باسم sound files يا عينى ع الدلع او بعد فتح التطبيق يتم الضغط على زر الأمر تحديث المكتبة القسم الايمن من الشاشة هو التحكم فى مشغل الوسائط برنامج الميديا بلاير الجزء الاوسط هو التنقل بين الاذاعة الصوتية وتعمل اون لاين او مكتبة ملفاتك من المجلد Sound files واسفل قائمة التشغيل التى تحتوى على الملفات خصائص واعدادات التشغيل والتكرار حاجه دلع الجزء الايسر وهو خاص بالتحكم فى الصوت لجهاز الحاسوب بس خلاص اسف انا باتصفح من الجوال مش قادر اعمل تنسيق للموضوع اكتر من كده ولا عارف ارفق صور فى انتظار ردكم بعد التجربة وفى الختام اتوجه بكل الشكر والتقدير والعرفان بالجميل لكل اساتذتى جميعا واخوانى فى هذا الصرح الشامخ الذين اتعلم منهم دائما وابدا اخص بالشكر الاستاذ القدير @jjafferr 🌹 حيث اننى دمجت بهذا المرفق الكثير مما قدمه من أفكار وتوجيهات عبر اشهر وسنوات وكذلك الاستاذ القدير @ابوخليل 🌹 كذلك استخدمت هنا الكثير من الاكواد التى تعلمتها منه عبر اشهر سنوات وباقى كوكبة اساتذتى الفضلاء واخوانى كل الشكر لكم 🌹🌹🌹 Digital Player App.zip

مرحبا استاذ @ازهر عبد العزيز اولا اعتذر عن التعديل على مرفقك لعدم توفر اكسس لدي لكون عملي حاليا في بيئة عمل مختلفة وفي هذا الرد سوف اضع تلميح لكيفية التحكم بانواع الحقول من خلال الكود واعتذر مقدما اذا لم تجد فيه الجواب المطلوب لتغيير الحقل الى نوع رقم Dim x As Variant x = "ALTER TABLE [tbl1] ALTER COLUMN [tx8] LONG" DoCmd.RunSQL x ويمكن كتابتة بالشكل التالي DoCmd.RunSQL "ALTER TABLE [tbl1] ALTER COLUMN [tx8] Integer" او DoCmd.RunSQL "ALTER TABLE [tbl1] ALTER COLUMN [tx8] LONG" حسب نوع الحقل الرقمي تغيير الحقل الى نوع مزدوج يكون على النحو التالي DoCmd.RunSQL "ALTER TABLE [tbl1] ALTER COLUMN [tx8] Double" الى نوع نص DoCmd.RunSQL "ALTER TABLE [tbl1] ALTER COLUMN [tx8] String" واذا اردنا ان نحدد طول الحقل النص يمكن كتابتة DoCmd.RunSQL ("ALTER TABLE [tbl1] ALTER COLUMN [tx8] TEXT(30);") اما حقل التاريخ فيكون DoCmd.RunSQL "ALTER TABLE [tbl1] ALTER COLUMN [tx8] date" النوع العملة يكون على النحو التالي DoCmd.RunSQL "ALTER TABLE [tbl1] ALTER COLUMN [tx8] Currency" لتحويل تنسيق الحقل الى علمي Set db = CurrentDb db.TableDefs("tbl1").Fields("tx8").Properties.Append db.CreateProperty("Format", dbText, "scientific") بعد تعديل التنسيق بالكود السابق تحتاج الى التعديل اليدوي في حالة الرغبة في التغيير مرة اخرى في جميع الاحوال لا انصح بالعبث في الحقول والمفروض ان التخطيط الجيد قبل واثناء انشاء قواعد البيانات يغني عن الحاجة للتعديلات اضافة الى ان تغيير نوع الحقل قد يؤدي الى فقدان البيانات لهذا الحقل وخصوصا اذا كان الحقل مرتبط بجداول اخرى قد يعطل عمل القاعدة

وعليكم السلام-لك ما طلبت JC new1.xlsx

جرب هذا الماكرو Option Explicit Sub ALL_in_one_cells() Dim ro, st$, i% ro = Cells(Rows.Count, 1).End(3).Row For i = 1 To ro If Cells(i, 1) <> vbNullString Then st = st & Cells(i, 1) & "," End If Next st = Mid(st, 1, Len(st) - 1) & "." Cells(3, 4) = st Cells(3, 4).Columns.AutoFit End Sub الملف مرفق One_for_All.xlsm

أخي بلال تفضل الآن بإمكانك تصدير واستيراد بيانات الموظف من القائمة والتعديل على ملف الاكسيل واستيراد التعديلات على ملف الموظف . كما ذكرت لي في الرسالة الخاصة لك . وبالتوفيق آمل التجربة وإخباري بالنتائج استراد وتصدير.accdb

وعليكم السلام 🙂 1. انت محتاج الى هذا الكود لنسخ المرفقات من قاعدة البيانات الى مجلد في الكمبيوتر : ' 'from 'https://docs.microsoft.com/en-us/office/vba/access/Concepts/Data-Access-Objects/work-with-attachments-in-dao ' ' Instantiate the parent recordset. Set rsEmployees = db.OpenRecordset("Employees") 'Code to move to desired employee ' Instantiate the child recordset. Set rsPictures = rsEmployees.Fields("Pictures").Value ' Loop through the attachments. While Not rsPictures.EOF ' Save current attachment to disk in the "My Documents" folder. rsPictures.Fields("FileData").SaveToFile _ "C:\Documents and Settings\Username\My Documents" rsPictures.MoveNext Wend 2. حذف حقول الرفقات من برنامجك ، 3. اذا عندك اكثر من مرفق لنفس السجل ، فالافضل ان تعرض اسماء المرفقات في النموذج ، والمستخدم ينقر على الصورة اللي يريده ، ويشوفها في النموذج : . جعفر

وهذا الكود يقوم بنفس العمل لكن مع عدد متغير من الصفوف يكفي ان تضع في الخلية I1 عدد الصفوف التي تريدا وتضغط على الزر Run مع تحديد نطاق الطباعة حسب الداتا التي حصلنا عليها Option Explicit Sub give_data_by_Y() If ActiveSheet.Name <> "data" Then Exit Sub Dim D As Worksheet, D2 As Worksheet Dim i%, x%, n%, Laste_Row%, Ro%, col%, m%, k%, last_col% Dim arr(), Tile() Dim y Set D = Sheets("data"): Set D2 = Sheets("data2") y = D.Range("i1") Laste_Row = D.Cells(Rows.Count, 1).End(3).Row D2.Cells.Clear x = (Laste_Row \ y) + 1 k = 1 ReDim arr(1 To x) For m = 1 To x arr(m) = y * (k - 1) + 3 k = k + 1 Next Ro = 3: col = 1 '++++++++++++++++++++++++++ Get The Result For k = 1 To UBound(arr) With D2.Cells(Ro, col).Resize(y) .Value = _ D.Range("A" & arr(k)).Resize(y).Value .Offset(, 1).Value = _ D.Range("B" & arr(k)).Resize(y).Value .Offset(, 2).Value = _ D.Range("G" & arr(k)).Resize(, y).Value End With D2.Cells(1, col + 3).ColumnWidth = 0.75 D2.Cells(4, col + 3).Formula = "=""""" col = col + 4 Next '++++++++++++++++++++++++++End Of The Result '__________________________Type The Titles last_col = D2.Cells(3, Columns.Count).End(1).Column Tile = Array("رقم ", "الاسم و اللقب ", "القسم") For m = 1 To last_col Step 4 D2.Cells(2, m + 3).Resize(y + 1). _ Interior.ColorIndex = 40 D2.Cells(2, m).Resize(, 3) = Tile Next '__________________________ End Of Typing The Titles '++++++++++++++++++++++++++ Format The Result With D2.Cells(2, 1).Resize(y + 1, last_col) .Borders.LineStyle = 1: .HorizontalAlignment = 1 .VerticalAlignment = 2: .Font.Size = 14 .Font.Bold = True: .InsertIndent 1 .Columns.AutoFit End With With D2.Cells(2, 1).Resize(, last_col) .HorizontalAlignment = 3 .Interior.ColorIndex = 6 End With n = Application.CountA(D2.Cells(2, last_col - 2).Resize(y)) If n < y Then D2.Cells(n + 2, last_col - 3).Resize(y - n + 1, 5).Clear End If '++++++++++++++++++++++++++ End Of The Format Of Result D2.PageSetup.PrintArea = D2.Range("A2").Resize(y + 1, last_col).Address Set D = Nothing: Set D2 = Nothing Erase arr: Erase Tile End Sub File Included New_std_salim_1.xlsm

انا وانت نعرف الكلمات التي لها معنى لكن الاكسل و كل كمبيوترات العالم لا تعرفها

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

لم اطلع على المرفق ولكني عملت لك هذا حسب ما فهمت Dim i As Integer Private Sub ID_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 13 Then i = i + 1 If i = 3 Then MsgBox "اعمل الإجراء" Exit Sub End If Else i = 0 End If End Sub test1.mdb

ألف سلامة استاذنا الغالى , شفاك الله وعافاك وبارك الله لنا فيك

وعليكم السلام اخى الكريم ,كان عليك استخدام خاصية البحث فى المنتدى فقد تكرر هذا الموضوع مئات المرات ومنه كما ترى: طباعة شيتات مرتب دفعة واحدة تعديل كود : طباعة أوراق محددة .. طباعة كل الشهادات كود طباعة لكل تسلسل الاسماء من نتائج معادلة vlookp من قائمة بمجموعة اسماء

وعليكم السلام-جرب هذا How to Copy or Import VBA Code to Another Workbook أو هذا Copy every worksheet from one excel file to another او يمكنك بطريقة بسيطة بأن تقوم بتحديد كل صفحات الملف بطريقة يدوية ثم بعد ذلك تقوم بالضغط كليك يمين بالماوس ثم اختيار move or Copy ثم بعد ذلك اختيار ملف الإكسيل الذى تريد نقل الصفحات اليه وتحديد كل الصفحات التى تريد نقلها ... فسيتم النقل ايضا بالمعادلات وبنفس تنسيقات الملف القديم اما بالنسبة لنقل الأكواد فقط عليك بفتح الملف القديم والملف الجديد والدخول الى محرر الأكواد بالضغط على Alt F11 ثم الضغط الى الكود الذى تريد نقله وسحبه الى المكان الجديد بالملف الجديد

بارك الله فيك وزادك الله من فضله ورحم الله والديك

جرب هذا تجريبي3.xlsm

حسنا عذرا لاني اكثرت عليك الاسئلة ولكن كنت اريد ان اعرف لو لديك الملف الرئيسي لابد ان يعمل بالكامل وقد نعرف كيفية التعديل عليه لقد توصلت الى شيء واحد وهو ان المشكلة في الملف نفسه لاني عندما قلت لك قم بتعديل الكود كنت قد جربته على ملف اخر وقام بالترحيل دون اي مشاكل فعليك تصميم ملف آخر ولقد قمت بنسخ جميع الاكواد لان الازرار مرتبطة معا بعضها وسؤالي الاخير عن البحث لا يعمل هو لمعرفة اذا كان الخلل من التعديل الاخير ام من البرنامج يمكنك تجربة الملف طبعا بالانجليزي لاني طرحت موضوعك في مواقع اجنبية وبالكاد رد علي موقع 1 من اصل 3 SH.xlsm

السلام عليكم اساتذتي الافاضل ورحمة الله وبركاته اذا امكن كود برمجي لفتح قاعدة بيانات اكسيس خارجية محمية برقم سري وحسب البرنامج المرفق DB_Pass.rar

شكرا استاذ خالد

وعليكم السلام أرفق ملفك .. ووضح طلبك أكثر ..

اخي مهند لقد حصلت على المساعدة من احد المبرمجين قم بتعديل هذا الكود واعلمني For c = 1 To ContColmn Ad = Cells(1, c).Address(0, 0) If Len(Trim(Me.Controls(Ad).Value)) = 0 Then MsgBox "address: " & Cells(1, c).Value & " empty", vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, "empty cells" Me.Controls(Ad).SetFocus Exit Sub End If Next

هذه المعلومة لم انتبه لها " المهم انك تعرفها "

السلام عليكم ورحمة الله استخدم المعادلة التالية =IF(AND(C3>=32;C3<=34);32;IF(AND(C3>=35;C3<=50);35;IF(AND(C3>=51;C3<=60);40;"")))

الف شكر أستاذ سليم مع تحياتي.🖕

ربما يكون كود افضل جرب المرفق Increment.xlsm

ما شاء الله تبارك الله بصراحة روقت على البرنامج وسأعتمده كصحاب لي أثناء العمل على الكمبيوتر . أعلم أن هذا العمل المبارك أخذ منك وقتاً كثيراً حتى يخرج بهذه الصورة الجميلة التي عوتنا عليها منذو عرفنا شخصيتك الرائعة ، ونحن نحبك في الله ، أدعوا الله لك بالتوفيق والسداد والشفاء العاجل وأن يمد عمرك ويبارك فيه والمسلمين جميعاً . وهدية مقبولة

النتيجة ممتازة حفظك الله و من تحب و رعاكم جميعا

رائع وممتاز .. سلمك الله ورعاك ووقفك لكل خير

السلام عليكم ورحمة الله تعالى وبركاته استاذى الجليل ومعلمى القدير و والدى الحبيب الاستاذ @jjafferr 🌹🌹🌹 جزاكم الله تعالى كل خير وانا بفضل الله تعالى توصلت الى نتيجة ولا اروع وبدون استخدام مساعدات من خارج الاكسس دخلت لابشركم ولكن سبقتونى اسال الله تعالى ان يجعلكم سباقون بالخيرات ويتقبل منكن اعمالكم ورزقكم البركة فى العمر والعلم والاهل والولد ... اللهم امين . امين . امين وهنا نتيجة كفاحى 😄

Sub ORDER() LRW = ActiveSheet.Range("C" & ActiveSheet.Rows.Count).End(xlUp).Row With ActiveSheet.Sort .SortFields.Add Key:=Range("I2"), ORDER:=xlDescending .SetRange Range("B2:I" & LRW + 1) .Header = xlYes .Apply End With End Sub تفضل ORDER.xlsm

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

تفضل الكود Private Sub Comand3_Click() If Len(Me.text & vbNullString) = 0 Then 'في حال عدم وجود شرط بحث strcriteria = Replace(strcriteria, " Where ", "") DoCmd.OpenReport "rptItems", acViewPreview, , strcriteria Else 'في حال وجود شرط بحث Dim RName, FldCriteria As String RName = "rptItems" FldCriteria = "[ID]=" & "'" & Me.text & "'" DoCmd.OpenReport RName, acViewPreview, , FldCriteria End If End Sub وبقية التفاضيل في برنامج الخليل في نموذج FrmFilteringQTY

استاذي الفاضل أحمد يوسف شكرا لك على تشحيعاتك لنا و تنبيهاتك لاعضاء المنتدى استاذ ASUS2020 انسخ هذا الجزء والصقه في الكود بزر "حضور" ويكون هو الاول If TextBox1 = "" Then MsgBox "المرجو ادخال الكود اولا": TextBox1.SetFocus: Exit Sub 'اذا كان التكست بوكس1 فاضي اديني رسالة "المرجو ادخال الكود اولا" واخرج من ساب

رما يكون في التعديل ما تقصد _سجل حضور وانصراف.xlsm

وعليكم السلام-لك ما طلبت تحويل الارقام الى عربي عند استدعاء البيانات1.xls

همممم اعتذر منك اخي حسين ، فانا وكما اخبرتك : .لازم تشوف ملف SDK الجهاز ، او ملف التحكم او اوامر الجهاز ، وبعدين ممكن نخطو للخطوة التالية 🙂 جعفر

بعد اذن الاستاذ واتراء للموضوع يمكنك استخدام الكود التالي في حدث ورقة العمل Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim rng Dim lr lr = Cells(Rows.Count, 1).End(3).Row Set rng = Range("a3:a" & lr) If Not Intersect(Target, rng) Is Nothing Then Range("j3:j" & lr).Formula = "=B3&"" ""&C3&"" ""&D3&"" ""&E3" Value = Value End If End Sub

تفضل لك ما طلبت Payroll.xlsm

بالمناسبة جرب تنفيذ هذا الكود و ترى العجائب Sub ARange_sheets() Dim t%, i% Dim col As Object, itm t = Sheets("Main").Index Set col = CreateObject("System.Collections.Arraylist") On Error Resume Next For i = t + 1 To Sheets.Count col.Add CInt(Sheets(i).Name) Next On Error GoTo 0 If col.Count Then col.Sort: col.Reverse For Each itm In col Sheets(itm & "").Move after:=Sheets(t) Next End If Set col = Nothing End Sub

مؤقت بسيط يجعل اكسل يحصي لك الثواني حتى رقم معين تحدده بنفسك ممكن استعماله عند طرح اسئلة معينه و الاجابة مطلوبة خلال فترة لا تتعدى هذا الرقم My_timer.xlsm

بالطبع سيكون عمل ممتاز استاذ سليم بارك الله فيك وزادك الله من فضله

تفضل 201.xlsx

أحسنت استاذ مجدى عمل رائع بارك الله فيك ورحم الله والديك

' 'هذا الكود للمحترم ياسر العربي Sub RoundedRectangle3_Click() Dim last As Long Dim y As Long '' اول صف سيوضع فيه التذييل y = 40 Do ' ' لمنع اهتزاز الشاشه Application.ScreenUpdating = False last = Sheets("ناجح").Cells(Rows.Count, "B").End(xlUp).Row If y - 36 >= last Then GoTo 0 ' ' اسم شيت المصدر الذي سيتم حشر الديباجه فيه Sheets("كعب الشيت").Rows("2:7").Copy ' ' اسم شيت الديباجه التى نريد وضعها في الشيت المصدر Sheets("ناجح").Rows(y).Insert Shift:=xlDown ' 'لايقاف خاصيه القص والنسخ Application.CutCopyMode = False ' ' y = y + 36 Loop ' ' لاعاده تحديث الشاشه 0 Application.ScreenUpdating = True MsgBox "تم بحمد لله" End Sub ' ' ' ' ' ' ' ' ' ' ' ' ' ' كود لتذييل الصفحه

السلام عليكم اخي هيثم حفظ المرفقات في البرنامج سيجعل حجم البرنامج كبير جدا ، وله عواقب وخيمة لهذا السبب ، فالنصيحة ان تحفظ المرفقات في مجلدات الوندوز ، ولكن تربط المرفق برقم ID السجل مثلا المنتدى مليئ بهذا النوع من الامثلة ، وهنا مجموعة امثلة أخونا الكبير ابو خليل: http://www.officena.net/ib/topic/60554-ادراج-صورة-من-الماسح-_-سحب-الصور/?do=findComment&comment=390508 http://www.officena.net/ib/topic/60554-ادراج-صورة-من-الماسح-_-سحب-الصور/ http://www.officena.net/ib/topic/55050-ادراج-صورة-_-اضافة-وحذف/ http://www.officena.net/ib/topic/62131-جلب-الصور-دفعة-واحدة-الى-مجلد-البرنامج-حسب-الاسم-المعرف/ وهنا مثال موسع لي: http://www.officena.net/ib/topic/62143-هدية-سحب-اكثر-من-صورة-من-الاسكنر-وتحويلها-الي-pdf-او-صور-مسلسلة/ وهذا مثال ، ولكن حيث يتم فتح المرفق بالبرنامج الافتراضي للكمبيوتر: http://www.officena.net/ib/topic/55053-فتح-صورة-بـ-مستعرض-الصور/ جعفر

يمكن استحدام هذا الماكرو Sub select_last_cell() Dim UR As Range Dim LastCell As Range Set UR = ActiveSheet.UsedRange Set LastCell = UR(UR.Cells.Count) LastCell.Select End Sub

السلام عليكم تم توسيع النطاق ، الآن يمكنكم تفقيط الأرقام حتى طول 21 خانة والكسور حتى 6 خانات ، كما تمت بعض التنقيحات الأخرى . تحياتي . Num2Text_20060728.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