محمد طاهر عرفه

حفظ المعلومات في الريجستي يكون باستخدام 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, "مجلد جديد" علماً أنني نقلته من أحد المواقع . وللجميع التحية

الضغط علي f2 يؤدي الي وضع المؤشر فى حالة التحرير و لعمل ذلك بالكود sendkeys "{F2}" و يوجد عليه مثال هنا و لتشغيل الاوامر المختلفة من أي مكان بالمفاتيح راجع هذا الموضوع و هو شرح للطريقة التي ذكرها مشكورا الأخ سمير و يمكن تخصيص استخدام الزر فى نموذج معين باستخدام حدث Onkey press للنموذج و سيفيد هذا المثال فى معرفة أكواد ال asci للتعامل مع هذا الحدث من هنا

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

بشرة خير :) هذا خبر جميل فى انتظار محاولات باقي الأخوة ملاحظة : تم تعديل رابط التنزيل أعلاه الي http://www.officena.net/Tips/MasterFormat.php

السلام عليكم اذا أنا فهمت الموضوع صح ، فيكون التصميم المناسب اضافة جدول الي التصميم السابق كالاتي جدول الحسابات (مثل السابق ) جدول ارقام التليفونات (مثل السابق ) جدول بيانات الفاتورة الاجمالية ( و فيه تضيف الحقول التي وصفتها بانك تريد اضافتها الي الجدول بعد التجميع )بالاضافة الي البيانات الاساسة للفاتورة ككل : كود الفاتورة الاجمالية ، بياناتها ، بالاضافة الي تاريخ الفاتورة الاجمالية جدول الفواتير التفصيلية (مثل السابق و يضاف اليه كود الفاتورة المجمعة) ( و اذا لم يكن هناك تاريخ منفصل للفواتير التفصيلية يتم حذف الحقل من جدول الفواتير التفصيلية و الاكتفاء بتاريخ الفاتورة المجمعة فى جدول الفواتير المجمعة) و بذلك بعمل تجميع لجدول تفاصيل الفاتورة GroupBY رقم الفاتورة يمكن الحصول علي مجموع كل فاتورة ، و يمكن ربط الناتج ببيانات جدول بيانات الفاتورة المجمعة عن طريق رقم الفاتورة

تم اضافة ثلاث تطبيقات الي قسم التطبيقات الخدمية فى الصفحة الرئيسية ( من برامج للعرض ) الاول اكواد الماستر فورمات ( للمهندسين ) الثاني تحويل المقايس ( لأبو هادي ) و الثالث ( التفقيط لأبو هادي )

السلام عليكم أرجو تجربة التعديل علي هذا الملف الموجود فى قسم التطبيقات الخدمية http://www.officena.net/Tips/MasterFormat.php مع تحياتي

أهلا بك دائما أخونا الكريم تم دمج المثالين فى مثال واحد مع حذف الجملة التالية من الكود Range("a1").Activate حيث لا داعي لها مرفق المثال CheckBuplicated.rar

شكرا علي الرابط :lol: 299 دولار :eek:

السلام عليكم بالنسبة لتعديل أي قيمة أو اضافة أو حذف للقيم المسجلة بالريجيستري فهذا متاح بالكود عن طريق استخدام دوال ال api و لكن ... أعتقد أن الموضوع هنا بخصوص هذه القيمة المسجلة فى الريجيستري و حيث أن هذه القيمة موجودة فى تصنيف محرك ال jet الذي يمكن وصفه بانه مدير التعامل مع قاعدة بيانات الاكسس أو المسئول عن تخزين و استجاع البيانات و حسب المكتوب فى موقع ميكروسوفت عن هذا الموضوع ( تحت بند تعديل قيم الريجيستري ) هنا http://msdn.microsoft.com/library/default....performance.asp انه بعمل عملية ترحيل يتم تنفيذ الحد الاقصي ، و هو 9500 ثم تفريغ المكان المحجوز و من ثم تنفيذ الباقي MaxLocksPerFile The MaxLocksPerFile setting determines the maximum number of locks that Microsoft Jet places against a file. The default setting is 9,500 locks. If the number of locks required to perform a transaction exceeds the MaxLocksPerFile setting, the transaction commits (writes) the data that has locks associated with it, frees the locks, and then continues processing the transaction. If the maximum number of locks a server can handle is less than the MaxLocksPerFile setting, the server returns an error message or appears to hang when performing a large transaction. If this occurs, you should decrease the MaxLocksPerFile setting. A Novell server can be configured to perform a maximum of 10,000 locks per connection. A Novell server connection can include more than one database, so its possible to exceed the maximum number of available locks if you are using more than one database at a time. فاذا تم تنفيذ ترحيل سجلات Transcation عموما ليس من المفترض حدوث المشكلة ، اما حدوثها عن النسح و اللصق الي قاعددة البيانات ، فاعتقد أن محاولة التغلب عليه ليست عملية حتي و ان كانت متاحة و انما يجب أن يتجه التفكير الي اعادة تنسيق ملف المصدر بحيث يمكن سحبه مباشرة الي الاكسس و ليس من خلال النسخ و اللصق مع تحياتي

السلام عليكم جرب هذا Private Sub Worksheet_Change(ByVal Target As Range) Dim Mymat(10) As Double Range("a1").Activate For i = 1 To 10 Mymat(i) = Range("a1").Offset(i - 1, 0).Value Next For i = 1 To 10 For j = 1 To 10 If Mymat(i) = Mymat(j) And i <> j And (Not Mymat(i) = 0 Or Not Mymat(j) = 0) Then MsgBox "cell no A" & i & "and A" & j & "are duplicated" Exit Sub End If Next j Next i End Sub مع تحياتي

السلام عليكم أهلا وسهلا بك فى المنتدي جرب هذا Private Sub Worksheet_Change(ByVal Target As Range) Dim Mymat(10) As Double Range("a1").Activate For i = 1 To 10 Mymat(i) = Range("a1").Offset(i - 1, 0).Value Next For i = 1 To 10 For j = 1 To 10 If Mymat(i) = Mymat(j) And i <> j Then MsgBox "cell no A" & i & "and A" & j & "are duplicated" Exit Sub End If Next j Next i End Sub

فى التقرير توجد خاصية Running Sum للحصول علي المجموع التراكمي للسجلات أما فى النماذج ، فللحصول علي المجموع التراكمي ، فهذا ملف مرفق به مثالين للأخوة حارث و أبو هاجر Cum____.rar

المثال المرفق ، فضلا عن استخدام الدالة ROUND يوجد دالتان للتقريب الاولي تقرب دائما الي الاعلي و الثانية تقرب بدرجة معينة Myround.rar

هذا مثال علي دوال تجميع المجال معد المثال هو الأخ مخلص الحريصي Aggregate.rar

1- هل تستخدم قاعدة بيانات أكسس عادية أم مشروع أكسس؟؟ 2-هل كانت المشكلة عند ادخال البيانات فى جدول أم عند استرجاعها فى استعلام او استدعاء recordset ؟؟ 3-هل تستخدم آخر اصدار ( اكس بي ) ؟؟

الأنساق التالية هي المكتوبة فى ملف التعليمات و لكن تحت مسمي مثال أي أنه يوجد غيرها : as .avi, .mov, .qt, .mpg, and .mpeg. و الانساق التالية تظهر عند محاولة ادراج ملف : cda , asf , asx , m3u, m1v,mp2 فلاختبارها أو ان كان مطلوب غيرها فالتجربة خير برهان :pp: اما عن ملفات التحويل فانصحك بزيارة مكتبة البرامج هنا http://www.arabsgate.com او http://www.alsayra.com

مرفق مثال وافي للأخ حارث عن اخفاء و اظهار الكائنات HidAll22_Harith.zip

فهرس الدورة من هنا

من هنا مرفق المثال Q5.zip

اعتقد أن هذا أول طرح لهذا السؤال فى أوفيسنا يتم عمل ذلك من insert object Power Point Presentation و بعد ذلك تأكد من أن خاصية data enabled = yes و أن خاصية other activateauto = got focus وهنا أثناءالاختيار يمكن تفعيل خيا رالربط أم لا

هل أنت متأكد من منح جميع الصلاحيات علي المجلد للمستخدمين جميعا؟؟ راجع الصلاحيات و للتأكد من عدم تأثيرها ، اجعل صلاحيات القراءة و التعديل و التحكم لهذه المجلدات مسموحة لجميع المستخدمين علي الشبكة للتأكد من عدم تأثير الصلاحيات أيضا راجع الخاصية التالية من ملف البيانات Tools options advanced default open mode و تاكد انها shared

لا أعتقد أنها ستؤثر فى حالة حقل الترقيم التلقائي لأن السجل الجديد يتم حجزه بمجرد البدء فى تسجيل البيانات بالنموذج و ليس عند فتح النموذج أو حفظه أي مع كتابة أول رقم أو حرف فى النموذج يتم حجز رقم الترقيم التلقائي . أما فى حالة كون الحقل ليس ترقيم تلقائي و لكن يعتمد علي زيادة واحد علي أكبر قيمة مسجلة فى الجدول باستخدام dmax - و هي الطريقة التي نلجأ لها عند الرغبة بالسماح بتغيير الرقم عند الحاجة - فهنا ستؤثر حيث ان حجز الرقم فى الجدول لن يتم الا مع حفظ السجل و لكن تصادف فرصة حجز نفس الرقم يمكن تقليلها و هي ستعتمد بشكل كبير علي تصميم و أكود نماذج الادخال ففي هذه الحالة قبل الانتقال للسجل التالي أو غلق النموذج ( قبل حفظ السجل ) نقوم باعادة اختبار آخر رقم مسجل فى الحقل الرقمي و بناء عليه نعدل قيمة الترقيم للسجل قبل الحفظ.

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

على فكرة انا وضعت البرنامج على network drive وجعلت مجلد للبيانات وبه الجداول وجلد آخر للنماذج البيانات فقط هي التي تكون موجودة علي مجلد فى الشبكة أما البرنامج أو الواجهة فتكون علي جهاز كل مستخدم علي حدة و يتم توجيه البيانات الي المجلد ال shared علي الشبكة أي لو عدد 7 مستخدمين ، يكون فيه 7 نسخ من الواجهة علي جهاز كل منهم ، مع نسخة بيانات واحدة فقط علي الشبكة و الجميع يوجهون مسار الجداول المرتبطة اليها