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

جئت متأخراً عموماً الحمدلله لأنك وجدت الحل، لكن إضافة بسيطة استاذ صالح انت تعلم ان بيئة الـ vb6 اصبحت من العصر الحجري وفي حواسيبنا اصبح استخدام ملفات الـ OCX قليل، لذا أقترح عليك ان تقوم بتنصيب حزمة ملفات الـ OCX وتريح نفسك من هالرسائل والمشاكل. تحميل ملفات الـ OCX: https://www.mediafire.com/file/56p7u9p62175d8d/OCX.rar/file

في نموذج fty في حدث بعد التحديث للحقل idx ضع الكود التالي Dim x As Integer x = DCount("[idx]", "tx", "[idx]='" & [idx] & "'") If x = 0 Then If MsgBox("هل ترغب باضافة هذا العميل", vbYesNo, "تنبيه") = vbYes Then DoCmd.OpenForm "ftx", , , , , , idx Else Me.Undo End If End If حجزنا متغير رقمي جعلنا قيمة المتغير = عدد السجلات المطابقة للحقل idx ثم وضعنا شرط اذا كان العدد 0 يظهر الرسالة من نوع نعم لا اذا اخترنا نعم يفتح نموذج ftx ونحمل قيمة الحقل idx في بارامتر OpenArgs اما اذا اخترنا "لا" يتم التراجع ثم في نموذج ftx في حدث عند الفتح نضع الكود التالي If Not IsNull(Me.OpenArgs) Then DoCmd.GoToRecord , , acNewRec Me.idx.Value = Me.OpenArgs End If هنا اشترطنا اذا كان OpenArgs غير فارغ ينقلنا الى وضع اضافة سجل جديد ثم نجعل قيمة الحقل idx تساوي القيمة المحملة في OpenArgs بالتوفيق اخ ازهر مع تحفظي على الفكرة جميل اخي ناقل ولكن عند فتح نموذج ftx ونموذج fty مغلق سوف تظهر رسالة خطا 🌹

تفضل اخي العزيز .... بس رجاءا لا تكرهني .... ههههههه yyyyyyyyyy.accdb

جرب هذا الكود Option Explicit Private Sub TextBox1000_Change() Dim x As Worksheet Dim c As Range Dim Arr_Sh, Itm Dim k%,b% Arr_Sh = Array("BB") ''يمكن هنا اضافة اسماء الشيتات التي تريد البحث فيها If TextBox1000.Value = "" Then ListBox1.Clear: Exit Sub Dim x As Worksheet Dim c As Range ListBox1.Clear k = 0 For Each Itm In Arr_Sh Set x = Sheets(Itm) ss = x.Cells(Rows.Count, 9).End(xlUp).Row If ss < 9 Then GoTo Next_Item For Each c In x.Range("A9:A" & ss) b = InStr(c, TextBox1000) If Trim(c) Like TextBox1000 & "*" Then ListBox1.AddItem ListBox1.List(k, 0) = x.Cells(c.Row, 1) ListBox1.List(k, 1) = Itm ListBox1.List(k, 2) = c.Row k = k + 1 End If Next c Next_Item: Next Itm End Sub

وعليكم السلام ورحمة الله وبركاته اذا كنت تريد حقل اسفل التقرير يظهر اجمالي " تم الدفع " واجمالي " لم يتم الدفع " سيكون كالتالي 1 - تم الدقع =Sum(IIf([حالة الدفع]="تم الدفع";[قيمة القسط];0)) 2 - لم يتم الدفع =Sum(IIf([حالة الدفع]="لم يتم الدفع";[قيمة القسط];0)) الاقساط.rar تحياتي

🤣🤣

الحمد لله، حلت المشكلة، أعدت تنزيل الخطوط، فقرئ الخط.

أخى الحبيب المتألق دائما // حسين مأمون والمعطاء بلا حدود لاأملك سوى دعائى لكم بصلاح الاحوال والله ياأخى لن أرى إخلاصا سوى إخلاصكم فأنتم نعم الاخ ونعم الصديق .... جزاكم الله خيرا عما تقدمه ابتغاء مرضاة الله ... ربنا يبارك فيكم وفى أولادكم واجعلهم ياربنا قرة عين لك ورزقكم الله تعالى ببرهم تحياتى لجميع أفراد الاسرة الكريمة منتدى اوفسنا الاخ العزيز حسين مأمون اريد ان اثقل عليك قليل اريد ان اضع في الخلايا معادلات بدلا من كود فيجول بيسك في التقرير 1والتقرير2 لاني اريد ان اعدل بعض التغييرات في التقرير 1 والتقرير 2

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

اتمنى ان يكون هذا الشيء ما تريد test (3).xlsm

السلام عليكم ورحمة الله وبركاته تقبل الله طاعتكم وجعلنا وإياكم من عتقاء رمضان، وبعد: التحديثات الأخيرة لم يتم المساس فيها بخدمة القرآن الكريم، والمشكلة -كما تفضلت- مشكلة خط، تحتاج لنقل محتويات مجلد fonts إلى مجلد الخطوط في الويندوز، أيضاً يظهر أن عندك بعض خطوط النظام ناقصة، ويتضح هذا من خلال عدم ظهور العبارات في نطاق الآيات؛ لذا المشكلة في خطوط النظام عندك. على فكرة، يتم العمل حالياً على إضافة مصحف المدينة النبوية لإضافة البيان، بحيث يتم إدراج الآيات منه، واستبدال الرسم الإملائي إلى مصحف المدينة، وفهرسة الآيات المكتوبة بمصحف المدينة آلياً، فدعواتكم أخي الحبيب.

عليكم السلام، اخوية شوف هذا الشرح

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

بكل بساطة، استخدم في الجدول حقل من نوع ( نعم/لا ). وعند إعارة الجهاز يتم تأشير هذا الحقل لهذا الجهاز، بمعنى ان الجهاز مشغول حالياً. وعند ارجاع الجهاز يتم الغاء علامة الصح من هذا الحقل بمعنى ان الجهاز أصبح فارغ ويمكن إعارته مرة اخرى.

شكرا جزيلا إخوتي الكرام لقد وجدت الأداة المناسبة في هذا الرابط https://answers.microsoft.com/en-us/windows/forum/windows_10-files/missing-file-mscomm32ocx/996447c3-3c1d-4d81-ac58-aa8284c5ed82

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

حل آخر في الملف المرفق... tarif.xls

لا افهم كيف بامكان خلية واحدة ان تظهر نتيجة اكثر من معادلة واحدة المعادلات المطلوبة في العامود N Nassim.xls

السلام عليكم فضلا انظر المرفق مع الشكر نزار دالة الوقت.xls

عليكم السلام والرحمة تفضل التعديل ارجو ان يكون طلبك ملاحظة : الكود يراعي يومي السبت والاحد فقط كعطل رسمية اما بقية العطل فيجب تحديدها وبعد معرفة كفاءة الكود يتم تعديل الكود على اساسها Reorder.rar

بالتأكيد وطبعاً تنفيذ كل هذا المطلوب بالمعادلات , لا يمكن عمل هذا نهائياً بالمعادلات وشكراً !!!!

كيفية التنفيذ للوصول للنتيجه اذاكان صعب بالمعادلات؟ 1 2 هل ممكن الربط كل جزء على حدى بالمعادلات او ربط الشيت المجمع بالترحيل فى شيت الاجازات المفصل فقط؟

الاخوة الافاضل: لدي جدول فيه بيانات حول اجازات الموظفين مثال: اسم الموظف من تاريخ لغاية محمد 20/08/2003 25/08/2003 حسن 15/07/2003 15/08/2003 عمر 02/09/2003 10/09/2003 محمد 20/08/2003 25/08/2003 محمد 06/06/2003 15/06/2003 عمر 06/06/2003 06/06/2003 وهكذا وقمت بعمل استعلام للجدول ومن ثم عملت نموذج وفية كمبوبوكس بحيث اختار اسم الموظف فيظهر لي جميع الاجازات التي اخذها مثال في حال اذا اخترت اسم "محمد" يظهر: محمد 20/08/2003 25/08/2003 محمد 20/08/2003 25/08/2003 محمد 06/06/2003 15/06/2003 وقد قمت بأعطاء التعليمة في الاستعلام بحيث في خانة الاسم تم وضع بأن يرتبط بكمبو بوكس ولكن لم ينجح الامر فهل لديكم حل لذلك افيدوني افادكم الله.

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

السلام عليكم ورحمة الله وبركاته اقدم اعتذاري ايها الاخوة الاحبة لدي سؤال ولم ولم سٌسمح لي بكتابة موضوع جديد اذا كان ما افعله مخالف لقوانين منداكم الرائع والذي اعتبره جزء من حياتي اليومية لما يحوي على مواضيع قيمة فأرجو ان يوجه لى نصيحة كيف اتصرف في مرة قادمة ان شاء الله السؤال هــــو: مطلوب مني عمل برنامج بسيطيكون به حقلين مرتبطين ببعضهما الاول هو cmpo به الوضيفة والثاني text به رقم الوظيفة الان اذا اخترنا من الكمبو اسم الوظيفة يظهر في التكست رقم الوظيفة ارجو المساعدة وسعة الصدر في تفصيل الجواب وهل استطيع عمل هذا الشيء بدون كـــــود وشكرا

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

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

السلام عليكم كيف أقوم بتفعيل كود أو ألغاءه بواسطة زر أمر ؟ بحيث يكون هناك زرين أمر الأول ( تشغيل الكود ) والثاني ( الغاء الكود ) والسلام

السلام عليكم ورحمة الله صادفتنى مشكلة بعد وصول عدد السجلات فى جدول معين الى 9500 سجل , وعلمت ان المشكل فى MaxLocksPerFile فقمت بفتح الريجيسرى (start- run - regedit) وبحثت عن (MaxLocksPerFile) وعدلت القيمة فيه الى رقم اكبر من 9500 . والسؤال : هل يمكن عمل ذلك اتوماتيكيا عند تشغيل البرنامج لأول مرة فقط؟ والله اسأل ان يوفق المسلمين

حفظ المعلومات في الريجستي يكون باستخدام SaveSetting كالتالي : SaveSetting "اسم التطبيق","اسم القسم","المفتاح","القيمة" مثال : SaveSetting "برنامجي", "نموذج الخيارات", "إظهار حقل", مربع_التدقيق_الأول والإستعادة أو القراءة تكون باستخدام GetSetting كالتالي : متغير= GetSetting ("اسم التطبيق","اسم القسم","المفتاح") مثال : مربع_التدقيق_الأول= GetSetting("إظهار حقل", "نموذج الخيارات", "برنامجي") ولايوجد في هذه الطريقة أي مشاكل نهائياً ، وقد طبقت ذلك في عدة برامج واستخدمه خاصة في خيارات المستخدم في القاعدة . وبإمكانك وضع قيم افتراضيه حالما يتم تحميل النموذج عندما لايجد قيم مسجله في الريجستي وللتأكد من عدم وجود قيمة استخدم : If GetSetting("اسم التطبيق", "اسم القسم", "المفتاح") = "" Then وإذا استخدمت متغير فاجعل من نوع Variant أو String . فائدة : ولحذف إدخال في سجل (للمثال السابق) : 1- لكافة التطبيق : DeleteSetting "برنامجي" 2- لحذف قسم واحد فقط : DeleteSetting "برنامجي","نموذج الخيارات" 3- لحذف إدخال واحد فقط : DeleteSetting "إظهار حقل", "نموذج الخيارات", "برنامجي" فائدة : لفتح ملف التسجيل لمعاينة التغييرات ؛ انقر ابدأ ثم تشغيل واكتب RegEdit وانتقل إلى HKEY_CURRENT_USER\Software\VB and VBA Program Settings وستجد اسم التطبيق انقر عليه وستجد الأقسام التي وضعتها داخل اسم التطبيق . ملاحظة هامة جداً : كن حذراً جداً من أي تغيير في السجل لاتعرف تأثيره لأنه قد يؤدي إلى في أسوأ الأحوال إلى توقف الوندوز عن العمل وفي أقلها تعطل بعض البرامج أو الخيارات أو غيرها . ------------------ وهذا الكود يمكنك من القراءة والكتابة وحذف قيمة من مفتاح مع ملاحظة أنه يمكن تخزين القيم وإنشاء مفاتيح تحت أحد الجذور الأربعة التالية لملف الريجستي : HKeyClassesRoot HKeyCurrentUser HKeyLocalMachine HKeyUsers والان اليكم الكود : Private Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type Private Declare Function RegCloseKey _ Lib "advapi32.dll" _ (ByVal lngHKey As Long) _ As Long Private Declare Function RegCreateKeyEx _ Lib "advapi32.dll" _ Alias "RegCreateKeyExA" _ (ByVal lngHKey As Long, _ ByVal lpSubKey As String, _ ByVal Reserved As Long, _ ByVal lpClass As String, _ ByVal dwOptions As Long, _ ByVal samDesired As Long, _ ByVal lpSecurityAttributes As Long, _ phkResult As Long, _ lpdwDisposition As Long) _ As Long Private Declare Function RegOpenKeyEx _ Lib "advapi32.dll" _ Alias "RegOpenKeyExA" _ (ByVal lngHKey As Long, _ ByVal lpSubKey As String, _ ByVal ulOptions As Long, _ ByVal samDesired As Long, _ phkResult As Long) _ As Long Private Declare Function RegQueryValueExString _ Lib "advapi32.dll" _ Alias "RegQueryValueExA" _ (ByVal lngHKey As Long, _ ByVal lpValueName As String, _ ByVal lpReserved As Long, _ lpType As Long, _ ByVal lpData As String, _ lpcbData As Long) _ As Long Private Declare Function RegQueryValueExLong _ Lib "advapi32.dll" _ Alias "RegQueryValueExA" _ (ByVal lngHKey As Long, _ ByVal lpValueName As String, _ ByVal lpReserved As Long, _ lpType As Long, _ lpData As Long, _ lpcbData As Long) _ As Long Private Declare Function RegQueryValueExBinary _ Lib "advapi32.dll" _ Alias "RegQueryValueExA" _ (ByVal lngHKey As Long, _ ByVal lpValueName As String, _ ByVal lpReserved As Long, _ lpType As Long, _ ByVal lpData As Long, _ lpcbData As Long) _ As Long Private Declare Function RegQueryValueExNULL _ Lib "advapi32.dll" _ Alias "RegQueryValueExA" _ (ByVal lngHKey As Long, _ ByVal lpValueName As String, _ ByVal lpReserved As Long, _ lpType As Long, _ ByVal lpData As Long, _ lpcbData As Long) _ As Long Private Declare Function RegSetValueExString _ Lib "advapi32.dll" _ Alias "RegSetValueExA" _ (ByVal lngHKey As Long, _ ByVal lpValueName As String, _ ByVal Reserved As Long, _ ByVal dwType As Long, _ ByVal lpValue As String, _ ByVal cbData As Long) _ As Long Private Declare Function RegSetValueExLong _ Lib "advapi32.dll" _ Alias "RegSetValueExA" _ (ByVal lngHKey As Long, _ ByVal lpValueName As String, _ ByVal Reserved As Long, _ ByVal dwType As Long, _ lpValue As Long, _ ByVal cbData As Long) _ As Long Private Declare Function RegSetValueExBinary _ Lib "advapi32.dll" _ Alias "RegSetValueExA" _ (ByVal lngHKey As Long, _ ByVal lpValueName As String, _ ByVal Reserved As Long, _ ByVal dwType As Long, _ ByVal lpValue As Long, _ ByVal cbData As Long) _ As Long Private Declare Function RegEnumKey _ Lib "advapi32.dll" _ Alias "RegEnumKeyA" _ (ByVal lngHKey As Long, _ ByVal dwIndex As Long, _ ByVal lpName As String, _ ByVal cbName As Long) _ As Long Private Declare Function RegQueryInfoKey _ Lib "advapi32.dll" _ Alias "RegQueryInfoKeyA" _ (ByVal lngHKey As Long, _ ByVal lpClass As String, _ ByVal lpcbClass As Long, _ ByVal lpReserved As Long, _ lpcSubKeys As Long, _ lpcbMaxSubKeyLen As Long, _ ByVal lpcbMaxClassLen As Long, _ lpcValues As Long, _ lpcbMaxValueNameLen As Long, _ ByVal lpcbMaxValueLen As Long, _ ByVal lpcbSecurityDescriptor As Long, _ lpftLastWriteTime As FILETIME) _ As Long Private Declare Function RegEnumValue _ Lib "advapi32.dll" _ Alias "RegEnumValueA" _ (ByVal lngHKey As Long, _ ByVal dwIndex As Long, _ ByVal lpValueName As String, _ lpcbValueName As Long, _ ByVal lpReserved As Long, _ ByVal lpType As Long, _ ByVal lpData As Byte, _ ByVal lpcbData As Long) _ As Long Private Declare Function RegDeleteKey _ Lib "advapi32.dll" _ Alias "RegDeleteKeyA" _ (ByVal lngHKey As Long, _ ByVal lpSubKey As String) _ As Long Private Declare Function RegDeleteValue _ Lib "advapi32.dll" _ Alias "RegDeleteValueA" _ (ByVal lngHKey As Long, _ ByVal lpValueName As String) _ As Long Public Enum EnumRegistryRootKeys HKeyClassesRoot = &H80000000 HKeyCurrentUser = &H80000001 HKeyLocalMachine = &H80000002 HKeyUsers = &H80000003 End Enum Public Enum EnumRegistryValueType rrkRegSZ = 1 rrkregbinary = 3 rrkRegDWord = 4 End Enum Private Const mcregOptionNonVolatile = 0 Private Const mcregErrorNone = 0 Private Const mcregErrorBadDB = 1 Private Const mcregErrorBadKey = 2 Private Const mcregErrorCantOpen = 3 Private Const mcregErrorCantRead = 4 Private Const mcregErrorCantWrite = 5 Private Const mcregErrorOutOfMemory = 6 Private Const mcregErrorInvalidParameter = 7 Private Const mcregErrorAccessDenied = 8 Private Const mcregErrorInvalidParameterS = 87 Private Const mcregErrorNoMoreItems = 259 Private Const mcregKeyAllAccess = &H3F Private Const mcregKeyQueryValue = &H1 Public Sub RegistryCreateNewKey( _ eRootKey As EnumRegistryRootKeys, _ strKeyName As String) Dim lngRetVal As Long Dim lngHKey As Long On Error GoTo PROC_ERR lngRetVal = RegCreateKeyEx(eRootKey, strKeyName, 0&, vbNullString, _ mcregOptionNonVolatile, mcregKeyAllAccess, 0&, lngHKey, 0&) If lngRetVal = mcregErrorNone Then RegCloseKey (lngHKey) End If PROC_EXIT: Exit Sub PROC_ERR: MsgBox "Error: " & Err.Number & ". " & Err.Description, , _ "RegistryCreateNewKey" Resume PROC_EXIT End Sub Public Sub RegistryDeleteKey( _ eRootKey As EnumRegistryRootKeys, _ strKeyName As String) Dim lngRetVal As Long On Error GoTo PROC_ERR ' Delete the key lngRetVal = RegDeleteKey(eRootKey, strKeyName) PROC_EXIT: Exit Sub PROC_ERR: MsgBox "Error: " & Err.Number & ". " & Err.Description, , _ "RegistryDeleteKey" Resume PROC_EXIT End Sub Public Sub RegistryDeleteValue( _ eRootKey As EnumRegistryRootKeys, _ strKeyName As String, _ strValueName As String) Dim lngRetVal As Long Dim lngHKey As Long On Error GoTo PROC_ERR ' Open the key lngRetVal = RegOpenKeyEx(eRootKey, strKeyName, 0, mcregKeyAllAccess, _ lngHKey) ' If the key was opened successfully, then delete it If lngRetVal = mcregErrorNone Then lngRetVal = RegDeleteValue(lngHKey, strValueName) End If PROC_EXIT: Exit Sub PROC_ERR: MsgBox "Error: " & Err.Number & ". " & Err.Description, , _ "RegistryDeleteValue" Resume PROC_EXIT End Sub Public Sub RegistryEnumerateSubKeys( _ eRootKey As EnumRegistryRootKeys, _ strKeyName As String, _ astrKeys() As String, _ lngKeyCount As Long) Dim lngRetVal As Long Dim lngHKey As Long Dim lngKeyIndex As Long Dim strSubKeyName As String Dim lngSubkeyCount As Long Dim lngMaxKeyLen As Long Dim typFT As FILETIME On Error GoTo PROC_ERR ' Open the key lngRetVal = RegOpenKeyEx(eRootKey, strKeyName, 0, mcregKeyAllAccess, _ lngHKey) If lngRetVal = mcregErrorNone Then 'find the number of subkeys, and redim the return string array lngRetVal = RegQueryInfoKey(lngHKey, vbNullString, 0, 0, lngSubkeyCount, _ lngMaxKeyLen, 0, 0, 0, 0, 0, typFT) If mcregErrorNone = lngRetVal Then If lngSubkeyCount > 0 Then ReDim astrKeys(lngSubkeyCount - 1) As String 'set up the while loop lngKeyIndex = 0 ' Pad the string to the maximum length of a sub key, plus 1 for null ' termination lngMaxKeyLen = lngMaxKeyLen + 1 strSubKeyName = Space$(lngMaxKeyLen) Do While RegEnumKey(lngHKey, lngKeyIndex, strSubKeyName, lngMaxKeyLen + 1) = 0 ' Set the string array to the key name, removing null termination If InStr(1, strSubKeyName, vbNullChar) > 0 Then astrKeys(lngKeyIndex) = Left$(strSubKeyName, InStr(1, strSubKeyName, _ vbNullChar) - 1) End If ' Increment the key index for the return string array lngKeyIndex = lngKeyIndex + 1 Loop End If ' return the new dimension of the return string array lngKeyCount = lngSubkeyCount End If ' Close the key RegCloseKey (lngHKey) End If PROC_EXIT: Exit Sub PROC_ERR: MsgBox "Error: " & Err.Number & ". " & Err.Description, , _ "RegistryEnumerateSubKeys" Resume PROC_EXIT End Sub Public Sub RegistryEnumerateValues( _ eRootKey As EnumRegistryRootKeys, _ strKeyName As String, _ astrValues() As String, _ lngValueCount As Long) Dim lngRetVal As Long Dim lngHKey As Long Dim lngKeyIndex As Long Dim strValueName As String Dim lngTempValueCount As Long Dim lngMaxValueLen As Long Dim typFT As FILETIME On Error GoTo PROC_ERR ' Open the key lngRetVal = RegOpenKeyEx(eRootKey, strKeyName, 0, mcregKeyAllAccess, _ lngHKey) If lngRetVal = mcregErrorNone Then 'find the number of subkeys, and redim the return string array lngRetVal = RegQueryInfoKey(lngHKey, vbNullString, 0, 0, 0, _ 0, 0, lngTempValueCount, lngMaxValueLen, 0, 0, typFT) If mcregErrorNone = lngRetVal Then If lngTempValueCount > 0 Then ReDim astrValues(lngTempValueCount - 1) As String 'set up the while loop lngKeyIndex = 0 ' Pad the string to the maximum length of a sub key, plus 1 for null ' termination lngMaxValueLen = lngMaxValueLen + 1 strValueName = Space$(lngMaxValueLen) Do While RegEnumValue(lngHKey, lngKeyIndex, strValueName, _ lngMaxValueLen + 1, 0, 0, 0, 0) = 0 ' Set the string array to the key name, removing null termination If InStr(1, strValueName, vbNullChar) > 0 Then astrValues(lngKeyIndex) = Left$(strValueName, InStr(1, strValueName, _ vbNullChar) - 1) End If ' Increment the key index for the return string array lngKeyIndex = lngKeyIndex + 1 Loop End If ' return the new dimension of the return string array lngValueCount = lngTempValueCount End If ' Close the key RegCloseKey (lngHKey) End If PROC_EXIT: Exit Sub PROC_ERR: MsgBox "Error: " & Err.Number & ". " & Err.Description, , _ "RegistryEnumerateValues" Resume PROC_EXIT End Sub Public Function RegistryGetKeyValue( _ eRootKey As EnumRegistryRootKeys, _ strKeyName As String, _ strValueName As String) _ As Variant Dim lngRetVal As Long Dim lngHKey As Long Dim varValue As Variant Dim strValueData As String Dim abytValueData() As Byte Dim lngValueData As Long Dim lngValueType As Long Dim lngDataSize As Long On Error GoTo PROC_ERR varValue = Empty lngRetVal = RegOpenKeyEx(eRootKey, strKeyName, 0&, mcregKeyQueryValue, _ lngHKey) If mcregErrorNone = lngRetVal Then lngRetVal = RegQueryValueExNULL(lngHKey, strValueName, 0&, lngValueType, _ 0&, lngDataSize) If lngRetVal = mcregErrorNone Then Select Case lngValueType ' String type Case rrkRegSZ: If lngDataSize > 0 Then strValueData = String(lngDataSize, 0) lngRetVal = RegQueryValueExString(lngHKey, strValueName, 0&, _ lngValueType, strValueData, lngDataSize) If InStr(strValueData, vbNullChar) > 0 Then strValueData = Mid$(strValueData, 1, InStr(strValueData, _ vbNullChar) - 1) End If End If If mcregErrorNone = lngRetVal Then varValue = Left$(strValueData, lngDataSize) Else varValue = Empty End If ' Long type Case rrkRegDWord: lngRetVal = RegQueryValueExLong(lngHKey, strValueName, 0&, _ lngValueType, lngValueData, lngDataSize) If mcregErrorNone = lngRetVal Then varValue = lngValueData End If ' Binary type Case rrkregbinary If lngDataSize > 0 Then ReDim abytValueData(lngDataSize) As Byte lngRetVal = RegQueryValueExBinary(lngHKey, strValueName, 0&, _ lngValueType, VarPtr(abytValueData(0)), lngDataSize) End If If mcregErrorNone = lngRetVal Then varValue = abytValueData Else varValue = Empty End If Case Else 'No other data types supported lngRetVal = -1 End Select End If RegCloseKey (lngHKey) End If 'Return varValue RegistryGetKeyValue = varValue PROC_EXIT: Exit Function PROC_ERR: MsgBox "Error: " & Err.Number & ". " & Err.Description, , _ "RegistryGetKeyValue" Resume PROC_EXIT End Function Public Sub RegistrySetKeyValue( _ eRootKey As EnumRegistryRootKeys, _ strKeyName As String, _ strValueName As String, _ varData As Variant, _ eDataType As EnumRegistryValueType) Dim lngRetVal As Long Dim lngHKey As Long Dim strData As String Dim lngData As Long Dim abytData() As Byte On Error GoTo PROC_ERR ' Open the specified key, If it does not exist then create it lngRetVal = RegCreateKeyEx(eRootKey, strKeyName, 0&, vbNullString, _ mcregOptionNonVolatile, mcregKeyAllAccess, 0&, lngHKey, 0&) ' Determine the data type of the key Select Case eDataType Case rrkRegSZ strData = varData & vbNullChar lngRetVal = RegSetValueExString(lngHKey, strValueName, 0&, eDataType, _ strData, Len(strData)) Case rrkRegDWord lngData = varData lngRetVal = RegSetValueExLong(lngHKey, strValueName, 0&, eDataType, _ lngData, Len(lngData)) ' Binary type Case rrkregbinary abytData = varData lngRetVal = RegSetValueExBinary(lngHKey, strValueName, 0&, eDataType, _ VarPtr(abytData(0)), UBound(abytData) + 1) End Select RegCloseKey (lngHKey) PROC_EXIT: Exit Sub PROC_ERR: MsgBox "Error: " & Err.Number & ". " & Err.Description, , _ "RegistrySetKeyValue" Resume PROC_EXIT End Sub ' مثال لإنشاء مفتاح رئيس تحت الجذر [CODE]RegistryCreateNewKey HKeyUsers, "New Floder\Sub Floder" ' مثال على إسناد قيمة لمفتاح فرعي ' إذا لم يجد المفتاح الفرعي فإنه ينشئه RegistrySetKeyValue HKeyUsers, "New Floder\Sub Floder", "اسم كائن", True, rrkRegSZ MsgBox RegistryGetKeyValue(HKeyUsers, "New Floder\Sub Floder", "اسم كائن") ' حذف قيمة مسندة لمفتاح فرعي RegistryDeleteValue HKeyUsers, "New Floder\Sub Floder", "اسم كائن" ' مثال لحذف مفتاح رئيس تحت الجذر RegistryDeleteKey HKeyUsers, "مجلد جديد" علماً أنني نقلته من أحد المواقع . وللجميع التحية

هذا المثال لمعرفة ال ASCI كود للازرار المختلفة و العكس ، أي معرفة الزر المناظر ل ASCI كود محدد و يفيد لمعرفة الاكواد حيث أن بعض الدوال و التي تتعلق بضغط الازرار مثل Form_KeyPress تستلزم معرفة هذه الاكواد للتعامل معها فى المثال اكتب الحرف ثم اضغط Enter لتري الكود المناظر chr_Asc2000.rar

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