كل الانشطه

سؤال لولبى شوف يا استاذى الحبيب واخى الجميل زى ما بينحكى انا اعطيتكم المكونات الرئيسية اما الطبخه عليكم طيب اجابة السؤال كالتالى : الكود لا يعتمد فى هذا الشكل على اى بيانات ولا هيكله ولا فى النموذج حاولت اعمل كل خطوة فى النموذج منفرده للتجربة وبما ان النموذج غير منضم وبما ان هيكل الكود لا يحتوى على اى بيانات ولا على اى ثوابت لبيانات تخص الاتصال بجهاز على الشبكة اذن عند نقل القاعدة لاى حاسوب لن يكون لها اى تأثير يذكر على نظام التشغيل الجديد الا اذا قمت باضافة بيانات من خلال النموذج طيب الفكرة الصحيحة او الطبخة المعتبرة : عمل جدول اعدادات الاتصال بالسيرفر يحتوى على بيانات اعتماد الاتصال ( اسم الجهاز او الـ IP + اسم المستخدم و كلمة المرور لهذا المستخدم ) وعمل نموذج اولى اول خطوة يتأكد من ان بيانات الاعتماد موجود اون لم تكن موجوده بسبب اى خلل يتم اضافتها وبمجرد اضافتها ينتقل لخطوة الاتصال بالقاعدة الخلفيه لعمل ريفريش للجداول المرتبطة او اعادة ربط أو ممكن بدلا من عمل التأكد من البيانات ثم الخروج فى حال وجوده الى ربط الجدول يتم عمل خطوة اضافة البيانات ثم اعادة الارتباط بالجداول ومتقلقش مش هيتم تكرار للبيانات فى Windows Credential طيب طول ما البيانات موجوده فى الجدول وطول ما ان الجهاز السيرفر لم يتغير اسمه او لم يتغير ال IP الخاص به حسب حسب مسار المجلد الشبكى سوف تعمل على هذا النهج حتى لو تم نقلها الى حاسوب جديد كليا طبعا فى حال نقل القاعدة الى شبكة أخرى فى مكان اخر او تغير اسم الحاسوب او بيانات الاتصال يتم تحديثها فى الجدول

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

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

بسيطة ان شاء الله اخي الكريم ، جرب هذا التعديل ، حيث تم استخدام الكود التالي للتحقق والاضافة عندم عدم وجود العام الدراسي الحالي . Private Sub MeetingDate_AfterUpdate() Dim academicYear As String Dim rs As DAO.Recordset Dim response As VbMsgBoxResult Dim prevDate As Variant On Error GoTo ErrHandler academicYear = IIf(Month(Me.MeetingDate) >= 9, _ Year(Me.MeetingDate) & "-" & (Year(Me.MeetingDate) + 1), _ (Year(Me.MeetingDate) - 1) & "-" & Year(Me.MeetingDate)) Set rs = CurrentDb.OpenRecordset("SELECT Academic_Name FROM AcademicYearTble WHERE Academic_Name = '" & academicYear & "'", dbOpenSnapshot) If rs.EOF Then response = MsgBox("العام الدراسي """ & academicYear & """ غير موجود." & vbCrLf & "هل تريد إضافته؟", vbQuestion + vbYesNo + vbMsgBoxRight, "إضافة عام دراسي") If response = vbYes Then CurrentDb.Execute "INSERT INTO AcademicYearTble (Academic_Name) VALUES ('" & academicYear & "')", dbFailOnError Me.Academic_Name = academicYear Else MsgBox "تم إلغاء التحديث.", vbExclamation Me.Undo End If Else Me.Academic_Name = academicYear End If rs.Close Set rs = Nothing Exit Sub ErrHandler: MsgBox "حدث خطأ: " & Err.Description, vbCritical + vbMsgBoxRight, "" On Error Resume Next rs.Close Set rs = Nothing End Sub الملف بعد التعديل AcademicYear2.accdb

في بيئات العمل الحديثة التي تعتمد على الشبكات المحلية، يُعد الاتصال المستقر بقاعدة البيانات الخلفية أمرًا أساسيًا لاستمرارية العمليات اليومية. ومع ذلك، تظهر أحيانًا مشكلات تقنية تتعلق بفقدان بيانات الاعتماد (اسم المستخدم وكلمة المرور) الخاصة بالوصول إلى مجلدات شبكية تحتوي على قاعدة البيانات. تخيل هذا السيناريو: · جهاز جديد ينضم إلى الشبكة. · أحد الأجهزة يتعرض لعطل مفاجئ، أو يتم إعادة تشغيله رغم تفعيل خيار "تذكر بيانات الاعتماد"، يفقد النظام هذه البيانات بعد التشغيل، مما يؤدي إلى انقطاع الاتصال بقاعدة البيانات وتعطل سير العمل. الحل: أداة متقدمة لإدارة بيانات الاعتماد تم تطوير كود ذكي لمعالجة هذه المشكلة بفعالية وكفاءة، من خلال : تخزين بيانات الاتصال (العنوان - اسم المستخدم - كلمة المرور) داخل نظام Windows Credential Manager المدمج في نظام التشغيل. أبرز المميزات: · سهولة الاستخدام: وظائف جاهزة لإضافة، استرجاع، وحذف بيانات الاعتماد بضغطة واحدة، دون الحاجة لأي معرفة برمجية. · ثبات الاتصال: يتم حفظ بيانات الاعتماد بشكل دائم حتى بعد إعادة تشغيل الجهاز، مما يضمن استمرارية الاتصال بقواعد البيانات دون الحاجة لإعادة الإدخال يدويًا. · نظام تسجيل احترافي: يسجل جميع العمليات والأخطاء في ملف خارجي، مما يسهّل تتبع المشكلات وحلها بسرعة وكفاءة. · توافق واسع: متوافق مع أنظمة Windows وOffice بنواتيها 32-بت و64-بت، ما يضمن عمله في مختلف بيئات العمل بدون مشاكل توافق. فوائد الكود: · توفير الوقت بإلغاء الحاجة إلى إدخال بيانات الاعتماد بشكل متكرر. · ضمان اتصال دائم وموثوق مع الشبكة وقواعد البيانات. · إمكانية التخصيص ليتناسب مع احتياجات كل مستخدم أو مؤسسة. · مناسب لجميع المستخدمين سواء المبتدئين أو المحترفين. الخاتمة: لا تدع مشكلات الشبكة تعرقل سير العمل. باستخدام هذه الأداة، يمكنك إدارة بيانات الاعتماد بكل كفاءة وأمان، مما يضمن اتصالًا ثابتًا ومستقرًا بقاعدة بياناتك في جميع الأوقات. إنها الحل المثالي لتطبيقات الشبكات المحلية التي تعتمد على الاتصال المستمر والسلس بقواعد البيانات. الكود Option Compare Database Option Explicit ' تعريفات Windows API للتعامل مع Credential Manager #If VBA7 Then Private Declare PtrSafe Function CredWrite Lib "Advapi32.dll" Alias "CredWriteW" (ByRef udtCREDENTIAL As udtCREDENTIAL, ByVal lngFlags As Long) As Long Private Declare PtrSafe Sub RtlMoveMemory Lib "kernel32" (ByVal lngDest As LongPtr, ByVal lngSrc As LongPtr, ByVal lngLen As LongPtr) Private Declare PtrSafe Function CredRead Lib "Advapi32.dll" Alias "CredReadW" (ByVal ptrTargetName As LongPtr, ByVal lngCredType As Long, ByVal lngFlags As Long, ByRef ptrCredential As LongPtr) As Long Private Declare PtrSafe Sub CredFree Lib "Advapi32.dll" (ByVal ptrBuffer As LongPtr) Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef bytDestination As Any, ByVal ptrSource As LongPtr, ByVal lngBytesCount As Long) Private Declare PtrSafe Function lstrcpyW Lib "kernel32" (ByVal ptrDest As LongPtr, ByVal ptrSrc As LongPtr) As LongPtr Private Declare PtrSafe Function CredDelete Lib "Advapi32.dll" Alias "CredDeleteW" (ByVal ptrTargetName As LongPtr, ByVal lngType As Long, ByVal lngFlags As Long) As Long Private Declare PtrSafe Function GetLastError Lib "kernel32" () As Long Private Declare PtrSafe Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As String, ByVal cbMultiByte As Long, ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As Long) As Long #Else Private Declare Function CredWrite Lib "advapi32.dll" Alias "CredWriteW" (ByRef udtCredential As udtCREDENTIAL, ByVal lngFlags As Long) As Long Private Declare Sub RtlMoveMemory Lib "kernel32" (ByVal lngDest As Long, ByVal lngSrc As Long, ByVal lngLen As Long) Private Declare Function CredRead Lib "Advapi32.dll" Alias "CredReadW" (ByVal ptrTargetName As Long, ByVal lngCredType As Long, ByVal lngFlags As Long, ByRef ptrCredential As Long) As Long Private Declare Sub CredFree Lib "Advapi32.dll" (ByVal ptrBuffer As Long) Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef bytDestination As Any, ByVal ptrSource As Long, ByVal lngBytesCount As Long) Private Declare Function lstrcpyW Lib "kernel32" (ByVal ptrDest As Long, ByVal ptrSrc As Long) As Long Private Declare Function CredDelete Lib "Advapi32.dll" Alias "CredDeleteW" (ByVal ptrTargetName As Long, ByVal lngType As Long, ByVal lngFlags As Long) As Long Private Declare Function GetLastError Lib "kernel32" () As Long Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As String, ByVal cbMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long #End If ' تعريف هيكل بيانات الاعتماد #If VBA7 Then Private Type udtCREDENTIAL lngFlags As Long ' العلامات التي تحدد سلوك بيانات الاعتماد lngType As Long ' نوع بيانات الاعتماد (عام أو خاص بنطاق) ptrTargetName As LongPtr ' مؤشر إلى اسم الهدف (اسم بيانات الاعتماد) ptrComment As LongPtr ' مؤشر إلى تعليق يصف بيانات الاعتماد curLastWritten As Currency ' وقت آخر تعديل لبيانات الاعتماد lngCredentialBlobSize As Long ' حجم بيانات الاعتماد (مثل كلمة المرور) lngptrCredentialBlob As LongPtr ' مؤشر إلى بيانات الاعتماد (مثل كلمة المرور) lngPersist As Long ' نوع التخزين (محلي، جلسة، أو مؤسسة) lngAttributeCount As Long ' عدد السمات الإضافية ptrAttributes As LongPtr ' مؤشر إلى السمات الإضافية ptrTargetAlias As LongPtr ' مؤشر إلى الاسم المستعار للهدف ptrUserName As LongPtr ' مؤشر إلى اسم المستخدم End Type #Else Private Type udtCREDENTIAL lngFlags As Long ' العلامات التي تحدد سلوك بيانات الاعتماد lngType As Long ' نوع بيانات الاعتماد (عام أو خاص بنطاق) ptrTargetName As Long ' مؤشر إلى اسم الهدف (اسم بيانات الاعتماد) ptrComment As Long ' مؤشر إلى تعليق يصف بيانات الاعتماد curLastWritten As Currency ' وقت آخر تعديل لبيانات الاعتماد lngCredentialBlobSize As Long ' حجم بيانات الاعتماد (مثل كلمة المرور) lngptrCredentialBlob As Long ' مؤشر إلى بيانات الاعتماد (مثل كلمة المرور) lngPersist As Long ' نوع التخزين (محلي، جلسة، أو مؤسسة) lngAttributeCount As Long ' عدد السمات الإضافية ptrAttributes As Long ' مؤشر إلى السمات الإضافية ptrTargetAlias As Long ' مؤشر إلى الاسم المستعار للهدف ptrUserName As Long ' مؤشر إلى اسم المستخدم End Type #End If ' الثوابت المستخدمة Private Const CRED_TYPE_GENERIC As Long = 1 ' نوع بيانات اعتماد عام Private Const CRED_PERSIST_LOCAL_MACHINE As Long = 2 ' تخزين بيانات الاعتماد محليًا Private Const CP_ACP As Long = 0 ' رمز الصفحة لتحويل النصوص Private Const ERROR_NOT_FOUND As Long = 1168 ' رمز الخطأ عند عدم العثور على بيانات الاعتماد Private Const MAX_LOG_SIZE As Long = 1048576 ' الحد الأقصى لحجم ملف السجل (1 ميجابايت) Public DebugMode As Boolean ' متغير عام للتحكم في طباعة التتبع في النافذة الفورية ' وظيفة لتسجيل الأخطاء Private Sub LogError(strFunction As String, strError As String, lngErrorCode As Long) ' الغرض: تسجيل الأخطاء في ملف Log مع اسم الوظيفة ورمز الخطأ If DebugMode Then Debug.Print "Error in " & strFunction & ": " & strError & " (Code: " & lngErrorCode & ")" End If WriteToLog LogPath, "خطأ في : " & strFunction & ": " & strError & " (Code: " & lngErrorCode & ")" End Sub ' وظيفة لتحويل رمز الخطأ إلى رسالة واضحة Private Function GetErrorMessage(lngErrorCode As Long, Optional strLang As String = "ar") As String If strLang = "ar" Then Select Case lngErrorCode Case ERROR_NOT_FOUND GetErrorMessage = "بيانات الاعتماد غير موجودة" Case 1312 GetErrorMessage = "اسم الهدف غير صالح أو غير موجود" Case 1008 GetErrorMessage = "لا يمكن تخصيص الذاكرة" Case Else GetErrorMessage = "خطأ غير معروف: " & lngErrorCode End Select Else Select Case lngErrorCode Case ERROR_NOT_FOUND GetErrorMessage = "Credential not found" Case 1312 GetErrorMessage = "Invalid or non-existent target name" Case 1008 GetErrorMessage = "Unable to allocate memory" Case Else GetErrorMessage = "Unknown error: " & lngErrorCode End Select End If End Function ' وظيفة لتحويل مؤشر سلسلة إلى نص Private Function strPtrToString(ByVal lngPtrString As LongPtr) As String ' الغرض: تحويل مؤشر سلسلة يونيكود إلى نص VBA ' المدخلات: lngPtrString - مؤشر إلى سلسلة يونيكود ' المخرجات: السلسلة النصية المستخرجة أو سلسلة فارغة إذا فشل التحويل On Error GoTo ErrHandler Dim strTemp As String ' التحقق من صحة المؤشر If lngPtrString = 0 Then strPtrToString = "" Exit Function End If ' تخصيص سلسلة مؤقتة بحجم كافٍ (255 حرفًا) ونسخ البيانات من المؤشر strTemp = String$(255, vbNullChar) lstrcpyW StrPtr(strTemp), lngPtrString ' استخراج النص حتى أول حرف null strPtrToString = Left$(strTemp, InStr(strTemp, vbNullChar) - 1) Exit Function ErrHandler: LogError "strPtrToString", Err.Description, Err.Number strPtrToString = "" End Function ' وظيفة لتحويل النص إلى يونيكود Private Function ConvertToUnicode(ByVal sInput As String) As String ' الغرض: تحويل سلسلة نصية إلى تنسيق يونيكود للاستخدام مع Windows API ' المدخلات: sInput - السلسلة النصية الأصلية ' المخرجات: السلسلة المحولة إلى يونيكود أو السلسلة الأصلية إذا فشل التحويل On Error GoTo ErrHandler Dim nChars As Long Dim sOutput As String ' التحقق من أن السلسلة غير فارغة If Len(sInput) = 0 Then ConvertToUnicode = "" Exit Function End If ' حساب عدد الأحرف المطلوبة لتحويل النص إلى يونيكود nChars = MultiByteToWideChar(CP_ACP, 0, sInput, Len(sInput), 0, 0) If nChars <= 0 Then LogError "ConvertToUnicode", "فشل تحويل النص إلى يونيكود", GetLastError ConvertToUnicode = sInput Exit Function End If ' تخصيص سلسلة الإخراج وإجراء التحويل sOutput = String$(nChars, vbNullChar) MultiByteToWideChar CP_ACP, 0, sInput, Len(sInput), StrPtr(sOutput), nChars ConvertToUnicode = sOutput Exit Function ErrHandler: LogError "ConvertToUnicode", Err.Description, Err.Number ConvertToUnicode = sInput End Function ' وظيفة لتحويل مصفوفة بايت إلى سلسلة يونيكود Private Function arrBytesToUnicodeString(arrBytes() As Byte) As String ' الغرض: تحويل مصفوفة بايت (تحتوي على بيانات يونيكود) إلى سلسلة نصية ' المدخلات: arrBytes - مصفوفة البايت التي تحتوي على بيانات يونيكود ' المخرجات: السلسلة النصية المستخرجة أو سلسلة فارغة إذا فشل التحويل On Error GoTo ErrHandler Dim strResult As String Dim lngChars As Long ' التحقق من أن المصفوفة ليست فارغة If UBound(arrBytes) < 0 Then arrBytesToUnicodeString = "" Exit Function End If ' حساب عدد الأحرف بناءً على حجم المصفوفة (يونيكود = 2 بايت لكل حرف) lngChars = UBound(arrBytes) \ 2 + 1 strResult = String$(lngChars, vbNullChar) ' نسخ البيانات من المصفوفة إلى السلسلة CopyMemory ByVal StrPtr(strResult), arrBytes(0), UBound(arrBytes) + 1 arrBytesToUnicodeString = strResult Exit Function ErrHandler: LogError "arrBytesToUnicodeString", Err.Description, Err.Number arrBytesToUnicodeString = "" End Function ' وظيفة لتحويل مؤشر بيانات إلى سلسلة Private Function ByteArrayToString(ByVal lpData As LongPtr, ByVal lngSize As Long) As String ' الغرض: تحويل بيانات من مؤشر (مثل كلمة المرور) إلى سلسلة نصية ' المدخلات: lpData - مؤشر إلى البيانات، lngSize - حجم البيانات بالبايت ' المخرجات: السلسلة النصية المستخرجة أو سلسلة فارغة إذا فشل التحويل On Error GoTo ErrHandler Dim arrBytes() As Byte ' التحقق من صحة المؤشر وحجم البيانات If lngSize <= 0 Or lpData = 0 Then ByteArrayToString = "" Exit Function End If ' تخصيص مصفوفة بايت ونسخ البيانات من المؤشر ReDim arrBytes(0 To lngSize - 1) CopyMemory arrBytes(0), ByVal lpData, lngSize ByteArrayToString = arrBytesToUnicodeString(arrBytes) Exit Function ErrHandler: LogError "ByteArrayToString", Err.Description, Err.Number ByteArrayToString = "" End Function ' وظيفة للتحقق من صحة المدخلات Public Function IsValidInput(strInput As String) As Boolean ' الغرض: التحقق من أن السلسلة صالحة (غير فارغة ولا تحتوي على أحرف غير مسموح بها) ' المدخلات: strInput - السلسلة المراد فحصها ' المخرجات: True إذا كانت السلسلة صالحة، False إذا لم تكن كذلك Dim strInvalidChars As String strInvalidChars = "<>|/\\:*?""" ' الأحرف غير المسموح بها ' التحقق من أن السلسلة غير فارغة بعد إزالة المسافات If Len(Trim(strInput)) = 0 Then IsValidInput = False Exit Function End If ' التحقق من وجود أحرف غير مسموح بها Dim i As Long For i = 1 To Len(strInvalidChars) If InStr(strInput, Mid(strInvalidChars, i, 1)) > 0 Then IsValidInput = False Exit Function End If Next i ' التحقق من الطول (مثلًا، الحد الأقصى 255 حرفًا) If Len(strInput) > 255 Then IsValidInput = False Exit Function End If IsValidInput = True End Function ' وظيفة للتحقق من أن السلسلة غير فارغة وخالية من محرف Null Public Function ValidateString(strInput As String) As Boolean ' أولاً، تحقق من أن السلسلة ليست فارغة بعد إزالة المسافات الزائدة ValidateString = Len(Trim(strInput)) > 0 ' إذا كانت السلسلة ليست فارغة، تحقق من عدم وجود محرف Null (vbNullChar) If ValidateString Then ValidateString = InStr(strInput, vbNullChar) = 0 End If End Function ' وظيفة لإضافة بيانات اعتماد إلى Windows Credential Manager Public Function AddWindowsCredential(strNetworkAddress As String, strNetworkUserName As String, strNetworkPassword As String) As Boolean On Error GoTo ErrHandler Dim udtCred As udtCREDENTIAL Dim lngResult As Long Dim strPasswordWithNull As String ' التحقق من صحة المدخلات If Not IsValidInput(strNetworkAddress) Or Not IsValidInput(strNetworkUserName) Then MsgBox "عنوان الشبكة أو اسم المستخدم غير صالح. يجب ألا يحتوي على أحرف غير مسموح بها أو يكون فارغًا.", vbCritical LogError "AddWindowsCredential", "مدخلات غير صالحة", 0 AddWindowsCredential = False Exit Function End If ' التحقق من طول كلمة المرور (اختياري، يمكن أن تكون فارغة) If Len(strNetworkPassword) > 255 Then MsgBox "كلمة المرور طويلة جدًا (الحد الأقصى 255 حرفًا).", vbCritical LogError "AddWindowsCredential", "كلمة المرور طويلة جدًا", 0 AddWindowsCredential = False Exit Function End If ' إضافة vbNullChar إلى كلمة المرور إذا لزم الأمر If Right$(strNetworkPassword, 1) <> vbNullChar Then strPasswordWithNull = strNetworkPassword & vbNullChar Else strPasswordWithNull = strNetworkPassword End If ' تهيئة هيكل بيانات الاعتماد With udtCred .lngFlags = 0 .lngType = CRED_TYPE_GENERIC .lngPersist = CRED_PERSIST_LOCAL_MACHINE .lngCredentialBlobSize = LenB(strPasswordWithNull) .ptrTargetName = StrPtr(strNetworkAddress) .ptrUserName = StrPtr(strNetworkUserName) .lngptrCredentialBlob = StrPtr(ConvertToUnicode(strPasswordWithNull)) .ptrComment = 0 .lngAttributeCount = 0 .ptrAttributes = 0 .ptrTargetAlias = 0 .curLastWritten = 0 End With lngResult = CredWrite(udtCred, 0) If lngResult = 0 Then Dim lngError As Long lngError = GetLastError() MsgBox "فشل في إضافة بيانات الاعتماد. الخطأ: " & GetErrorMessage(lngError), vbCritical LogError "AddWindowsCredential", GetErrorMessage(lngError), lngError AddWindowsCredential = False Exit Function End If AddWindowsCredential = True Exit Function ErrHandler: LogError "AddWindowsCredential", Err.Description, Err.Number MsgBox "حدث خطأ غير متوقع: " & Err.Description, vbCritical AddWindowsCredential = False End Function ' وظيفة لقراءة بيانات الاعتماد من Windows Credential Manager Public Function ReadWindowsCredential(ByVal strNetworkAddress As String, ByRef strOutNetworkUserName As String, ByRef strOutNetworkPassword As String) As Boolean On Error GoTo ErrHandler Dim ptrCredential As LongPtr Dim typCred As udtCREDENTIAL Dim lngResult As Long Dim strTemp As String ' التحقق من صحة المدخلات If Not IsValidInput(strNetworkAddress) Then MsgBox "عنوان الشبكة غير صالح. يجب ألا يحتوي على أحرف غير مسموح بها أو يكون فارغًا.", vbCritical LogError "ReadWindowsCredential", "عنوان الشبكة غير صالح", 0 ReadWindowsCredential = False Exit Function End If lngResult = CredRead(StrPtr(strNetworkAddress), CRED_TYPE_GENERIC, 0, ptrCredential) If lngResult = 0 Then Dim lngError As Long lngError = GetLastError() MsgBox "فشل في قراءة بيانات الاعتماد. الخطأ: " & GetErrorMessage(lngError), vbCritical LogError "ReadWindowsCredential", GetErrorMessage(lngError), lngError ReadWindowsCredential = False Exit Function End If ' التحقق من صحة المؤشر If ptrCredential = 0 Then MsgBox "فشل في تخصيص الذاكرة لبيانات الاعتماد", vbCritical LogError "ReadWindowsCredential", "مؤشر بيانات الاعتماد غير صالح", 0 ReadWindowsCredential = False Exit Function End If ' نسخ البيانات إلى الهيكل CopyMemory typCred, ByVal ptrCredential, LenB(typCred) strOutNetworkUserName = strPtrToString(typCred.ptrUserName) If typCred.lngCredentialBlobSize > 0 Then strTemp = strPtrToString(typCred.lngptrCredentialBlob) If LenB(strTemp) = 0 Then strOutNetworkPassword = ByteArrayToString(typCred.lngptrCredentialBlob, typCred.lngCredentialBlobSize) Else strOutNetworkPassword = Left$(strTemp, typCred.lngCredentialBlobSize \ 2) End If Else strOutNetworkPassword = "" End If ' تحرير الذاكرة CredFree ptrCredential ReadWindowsCredential = True Exit Function ErrHandler: If ptrCredential <> 0 Then CredFree ptrCredential LogError "ReadWindowsCredential", Err.Description, Err.Number ReadWindowsCredential = False End Function ' وظيفة لقراءة بيانات الاعتماد وإرجاعها ككائن Dictionary Public Function ReadWindowsCredentialByNetworkAddress(strNetworkAddress As String) As Object On Error GoTo ErrHandler Dim objResult As Object Dim strNetworkUserName As String Dim strNetworkPassword As String ' التحقق من صحة المدخلات If Not IsValidInput(strNetworkAddress) Then LogError "ReadWindowsCredentialByNetworkAddress", "عنوان الشبكة غير صالح", 0 Set ReadWindowsCredentialByNetworkAddress = Nothing Exit Function End If If ReadWindowsCredential(strNetworkAddress, strNetworkUserName, strNetworkPassword) Then Set objResult = CreateObject("Scripting.Dictionary") If objResult Is Nothing Then LogError "ReadWindowsCredentialByNetworkAddress", "فشل في إنشاء كائن Dictionary", 0 Set ReadWindowsCredentialByNetworkAddress = Nothing Exit Function End If objResult("NetworkUserName") = strNetworkUserName objResult("NetworkPassword") = strNetworkPassword Set ReadWindowsCredentialByNetworkAddress = objResult Else Set ReadWindowsCredentialByNetworkAddress = Nothing End If Exit Function ErrHandler: LogError "ReadWindowsCredentialByNetworkAddress", Err.Description, Err.Number Set ReadWindowsCredentialByNetworkAddress = Nothing End Function ' وظيفة لحذف بيانات الاعتماد من Windows Credential Manager Public Function DeleteWindowsCredential(strNetworkAddress As String) As Boolean On Error GoTo ErrHandler Dim lngResult As Long Dim lngLastError As Long ' التحقق من صحة المدخلات If Not IsValidInput(strNetworkAddress) Then MsgBox "عنوان الشبكة غير صالح. يجب ألا يحتوي على أحرف غير مسموح بها أو يكون فارغًا.", vbCritical LogError "DeleteWindowsCredential", "عنوان الشبكة غير صالح", 0 DeleteWindowsCredential = False Exit Function End If lngResult = CredDelete(StrPtr(strNetworkAddress), CRED_TYPE_GENERIC, 0) If lngResult <> 0 Then DeleteWindowsCredential = True Else lngLastError = GetLastError() MsgBox "فشل في حذف بيانات الاعتماد. الخطأ: " & GetErrorMessage(lngLastError), vbCritical LogError "DeleteWindowsCredential", GetErrorMessage(lngLastError), lngLastError DeleteWindowsCredential = False End If Exit Function ErrHandler: LogError "DeleteWindowsCredential", Err.Description, Err.Number DeleteWindowsCredential = False End Function Public Function GetCredentialsByNetworkAddress(strNetworkAddress As String, _ ByRef strUserName As String, _ ByRef strPassword As String) As Boolean ' هنا يمكنك استدعاء دالة قراءة البيانات حسب عنوان الشبكة Dim objDict As Object ' استدعاء دالة قراءة بيانات الاعتماد باستخدام العنوان Set objDict = ReadWindowsCredentialByNetworkAddress(strNetworkAddress) If Not objDict Is Nothing Then ' إذا كانت البيانات موجودة في القاموس، نقوم بإرجاعها في المتغيرات strUserName = objDict("NetworkUserName") strPassword = objDict("NetworkPassword") GetCredentialsByNetworkAddress = True Else ' في حال لم تجد البيانات GetCredentialsByNetworkAddress = False End If End Function ' (IP Address / عنوان الشبكة / اسم الجهاز) استخراج Function GetNetworkAddressOrIP(Path As String) As String Dim parts() As String ' التحقق إذا كان المسار يبدأ بـ \\ If Left(Path, 2) = "\\" Then ' إزالة \\ من البداية Path = Mid(Path, 3) ' تقسيم المسار إلى أجزاء باستخدام العلامة \ parts = Split(Path, "\") ' إرجاع الجزء الأول (اسم الجهاز أو عنوان IP) If UBound(parts) >= 0 Then GetNetworkAddressOrIP = parts(0) Else GetNetworkAddressOrIP = "" End If Else ' إذا لم يبدأ بـ \\، يرجع قيمة فارغة GetNetworkAddressOrIP = "" End If End Function ' وظيفة للحصول على مسار ملف السجل Function LogPath() As String ' الغرض: إرجاع مسار ملف السجل الأساسي LogPath = CurrentProject.Path & "\Logs\NetworkConnectionLog.txt" End Function ' وظيفة للحصول على مسار ملف السجل مع دعم التدوير Private Function GetRotatedLogPath(ByVal BaseLogPath As String) As String ' الغرض: إرجاع مسار ملف السجل، مع إنشاء ملف جديد إذا تجاوز الحجم الحد الأقصى ' المدخلات: BaseLogPath - المسار الأساسي لملف السجل ' المخرجات: المسار الفعلي لملف السجل (قد يكون ملفًا جديدًا إذا لزم الأمر) Dim FileSystem As Object Dim FileSize As Long Dim Counter As Integer Dim NewLogPath As String Set FileSystem = CreateObject("Scripting.FileSystemObject") ' إذا لم يكن الملف موجودًا، استخدم المسار الأساسي If Not FileSystem.FileExists(BaseLogPath) Then GetRotatedLogPath = BaseLogPath Exit Function End If ' التحقق من حجم الملف FileSize = FileSystem.GetFile(BaseLogPath).Size If FileSize < MAX_LOG_SIZE Then GetRotatedLogPath = BaseLogPath Exit Function End If ' إنشاء ملف جديد بإضافة رقم تسلسلي Counter = 1 Do NewLogPath = FileSystem.GetParentFolderName(BaseLogPath) & "\" & FileSystem.GetBaseName(BaseLogPath) & "_" & Format(Counter, "000") & "." & FileSystem.GetExtensionName(BaseLogPath) If Not FileSystem.FileExists(NewLogPath) Then GetRotatedLogPath = NewLogPath Exit Function End If Counter = Counter + 1 Loop Until Counter > 999 ' الحد الأقصى لعدد الملفات المدورة ' إذا لم يتم العثور على مسار متاح، استخدم المسار الأساسي GetRotatedLogPath = BaseLogPath End Function ' وظيفة لإرجاع رمز الخطأ الأخير Public Function GetLastErrorCode() As Long GetLastErrorCode = GetLastError() End Function ' تسجيل الأحداث والأخطاء في ملف Public Sub WriteToLog(ByVal LogPath As String, ByVal Message As String) ' الغرض: تسجيل الأحداث والأخطاء في ملف Log مع دعم تدوير السجلات ' المدخلات: LogPath - المسار الأساسي لملف Log، Message - الرسالة المراد تسجيلها On Error GoTo LogError Dim FileSystem As Object Dim LogFile As Object Dim ActualLogPath As String Set FileSystem = CreateObject("Scripting.FileSystemObject") ' إنشاء مجلد Logs إذا لم يكن موجودًا If Not FileSystem.FolderExists(FileSystem.GetParentFolderName(LogPath)) Then FileSystem.CreateFolder FileSystem.GetParentFolderName(LogPath) End If ' التحقق من أذونات الكتابة If Not IsFolderWritable(FileSystem.GetParentFolderName(LogPath)) Then If DebugMode Then Debug.Print "لا توجد أذونات كتابة لمسار Log: " & LogPath End If GoTo LogCleanUp End If ' الحصول على مسار السجل مع دعم التدوير ActualLogPath = GetRotatedLogPath(LogPath) ' فتح ملف Log وكتابة الرسالة Set LogFile = FileSystem.OpenTextFile(ActualLogPath, 8, True) ' 8 = للإلحاق LogFile.WriteLine Now & " - " & Message LogFile.Close LogCleanUp: Set LogFile = Nothing Set FileSystem = Nothing Exit Sub LogError: If DebugMode Then Debug.Print "خطأ في كتابة ملف Log: " & Err.Description End If Resume LogCleanUp End Sub Public Function IsFolderWritable(ByVal FolderPath As String) As Boolean ' الغرض: التحقق من إمكانية الكتابة في المجلد ' المدخلات: مسار المجلد ' المخرجات: True إذا كان المجلد قابلًا للكتابة، False إذا لم يكن كذلك On Error Resume Next Dim FileSystem As Object Dim TestFile As String Dim TestStream As Object Set FileSystem = CreateObject("Scripting.FileSystemObject") TestFile = FolderPath & "\test_write_" & Format(Now, "yyyymmddhhnnss") & ".tmp" Set TestStream = FileSystem.CreateTextFile(TestFile, True) If Not TestStream Is Nothing Then TestStream.Close FileSystem.DeleteFile TestFile IsFolderWritable = True Else IsFolderWritable = False End If Set TestStream = Nothing Set FileSystem = Nothing End Function ' ==================================================== ' أمثلة لدوال اختبار الكود ' ==================================================== ' ==================================================== ' إضافة بيانات اعتماد (اسم مستخدم وكلمة مرور) ' ==================================================== Public Sub TestAddWindowsCredential() Dim strNetworkAddress As String Dim strNetworkUserName As String Dim strNetworkPassword As String Dim blnSuccess As Boolean ' بيانات اعتماد تجريبية strNetworkAddress = "TestTarget0123" strNetworkUserName = "TestUser0123" strNetworkPassword = "TestPass0123" ' استدعاء دالة الإضافة blnSuccess = AddWindowsCredential(strNetworkAddress, strNetworkUserName, strNetworkPassword) ' عرض النتيجة MsgBox "AddWindowsCredential Result: " & blnSuccess, vbInformation End Sub ' ==================================================== ' قراءة بيانات اعتماد كاملة ' ==================================================== Public Sub TestReadWindowsCredential() Dim strNetworkAddress As String Dim strNetworkUserName As String Dim strNetworkPassword As String Dim blnSuccess As Boolean ' عنوان الشبكة المطابق لبيانات الاعتماد المخزنة strNetworkAddress = "TestTarget0123" ' استدعاء دالة القراءة blnSuccess = ReadWindowsCredential(strNetworkAddress, strNetworkUserName, strNetworkPassword) ' عرض النتيجة If blnSuccess Then MsgBox "UserName: " & strNetworkUserName & vbCrLf & "Password: " & strNetworkPassword, vbInformation, "ReadWindowsCredential" Else MsgBox "Failed to read credential.", vbExclamation End If End Sub ' ==================================================== ' قراءة بيانات الاعتماد ' ==================================================== Public Sub TestReadWindowsCredentialSimple() Dim strNetworkAddress As String Dim objDict As Object ' العنوان المرتبط ببيانات الاعتماد strNetworkAddress = "moh3sam" Set objDict = ReadWindowsCredentialByNetworkAddress(strNetworkAddress) If Not objDict Is Nothing Then MsgBox "UserName: " & objDict("NetworkUserName") & vbCrLf & "Password: " & objDict("NetworkPassword"), vbInformation, "ReadWindowsCredentialSimple" Else MsgBox "Failed to read credential " & strNetworkAddress & ".", vbExclamation End If If DebugMode Then Debug.Print "" & objDict("NetworkUserName") Debug.Print "" & objDict("NetworkPassword") End If End Sub ' ==================================================== ' حذف بيانات الاعتماد المخزنة ' ==================================================== Public Sub TestDeleteWindowsCredential() Dim strNetworkAddress As String Dim blnSuccess As Boolean ' العنوان الذي نريد حذف بياناته strNetworkAddress = "moh3sam" ' استدعاء دالة الحذف blnSuccess = DeleteWindowsCredential(strNetworkAddress) ' عرض النتيجة MsgBox "DeleteWindowsCredential Result: " & blnSuccess, vbInformation End Sub صور توضح مكان حفظ أو جلب بيانات الاعتماد من النظام وأخيرا المرفق إدارة بيانات الاعتماد.zip

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

وعليكم السلام ورحمة الله تعالى وبركاته حل اخر لتجاهل ورقة ff مثلا Option Explicit Sub call1() Dim CrWS As Worksheet, WS As Worksheet Dim Tbl As Integer, lastCol As Integer Set CrWS = ThisWorkbook.Sheets("ff") Tbl = 4 lastCol = 21 CrWS.Range(CrWS.Cells(3, Tbl), CrWS.Cells(3, lastCol)).ClearContents For Each WS In ThisWorkbook.Sheets If WS.Name <> CrWS.Name Then CrWS.Cells(3, Tbl).Value = WS.Name Tbl = Tbl + 1 End If Next WS End Sub

صحيح هذا تصحيح للمثال كما تفضلت .. لعله يناسب ابو عبدالله AcademicYear2.rar

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

لا تعلو عين فوق حاجبها .. أنتم الأصل ومنكم نستفيد ونتعلم معلمي الفاضل . بالطبع هو أفضل ، وإن كان لي رأي في التصميم نفسه !! فما الحاجة لأن يكون مكرراً قيمة السنة في مربعي نص ( كود السنة الاكاديمية ، و اختيار السنة الاكاديمية ) . ولكني تماشيت مع طلبه ليس إلا .

من فضلكم اريد برنامج محاسبي لشركات المقاولات مصمم بواسطة برنامج الإكسل على أن يكون آلي و مستخدم فيه معادلات مالية وحسابية متقدمة و VBA وماكرو وربط بين القوائم و الصفحات .... الخ برنامج متكامل وشامل للقوائم المالية والتحليلة وطبقاً للمعايير المحاسيبة الدولية والأنظمة السعودية.

في كانت كفكرة تشبيه إنه يكون عنده أكثر من فاتورة = أكثر من طاولة . ومن الغير طبيعي انه يكون الكاشير قادر على التعامل مع أكثر من 3 فواتير تقريباً .. فهنا ممكن يكون عنده زر "فواتير مستخدمة الآن" على سبيل المثال . ويقدر يحجز فاتورة بسجل جديد الفكرة كانت تشبيه فقط ، كأن المستخدم عنده أكثر من فاتورة شغالة في نفس الوقت ، زي نظام الطاولات في مطعم ، كل طاولة لها فاتورة خاصة ، ويتنقل بينها بحرية . وطبيعي إن الكاشير ما يقدر يتابع أكثر من 2 أو 3 فواتير بنفس الوقت ، فممكن يكون فيه زر مثلاً اسمه "فواتير قيد الاستخدام" ، يعرض له الفواتير المفتوحة اللي ما تم إنهاؤها . يقدر من خلاله يحجز فاتورة جديدة (زي حجز طاولة) ، ويتنقل بين الفواتير النشطة ، وينهيها وقت الدفع . وطبعاً هنا نقدر نسمي الفكرة بـ "تعليقا فاتورة" بحيث عند النقر عليه يتم تعليقا الفاتورة والإستفادة من فكرة الحقل Yes/No السابق ذكره ,

فتح نفس النموذج لعدد غير محدود

انا كنت اعمل على المثال .. وسبقتني 👍 يوجد حل افضل .. وهو تحويل القائمة الى مربع نص وهنا لن يكون بحاجة الى جدول السنوات Academicyeartble

زدنا تفصيلا بارك الله فيك .. اعجبني لأن مثال السائل يشتمل على رأس فاتورة وتفاصيل

بالطبع سيكون الموضوع أكبر من مجرد قيمة = قيمة ، فماذا لو كان الاختيار لتاريخ أكبر بـ 5 سنوات وغير مدرج في الكومبوبوكس Academic_Name !!!!

أخي @algammal ربما ما لم تلاحظه هو أن القيم تعبأ على عناصر الكومبوبوكس مع تجاهل الفراغات والتكرارات ولهذا السبب تظهر معك مرة واحدة فقط وذلك لأن أرقام التسلسل الموجودة على ورقة معاشات هي نفسها الموجودة على الـ DATA ما يهمنا هنا هو جلب جميع البيانات المتوفرة على الورقتين التي تتضمن شروط التصفية المختارة وهذا واضح من خلال الإحصائيات أسفله وللتوضيح أكثر دعنا نجرب إضافة تسلسل جديد على ورقة المعاشات غير موجود مسبقا في DATA ونرى كيف سيتم التعامل معه لاحظ معي عند اختيار رقم التسلسل 1 الاحصائيات لدينا تظهر عدد الموظفين 2 على ورقة معاشات 1 وورقة DATA 1 أرفق لك آخر تحديث للملف توحيد البحث في شيت واحد v7.xlsb

تمام استاذنا .. ويمكن وضع ضابط من اجل تجاوز الخطأ فيما لو لم تكن القيمة موجودة ضمن القائمة

وعليكم السلام ورحمة الله وبركاته ،، مشاركة معنوية مع الأساتذة والمعلمين ، وكفكرة أستاذنا @kkhalifa1960 ، هي جميلة وتجهلك تتنقل بين الفواتير التي تريدها ، وتستطيع التعديل عليها كتحسين ( لا ينقص من جمالها شيء طبعاً ) بحيث يتم تعليم الفواتير التي تم دفعها بحقل Yes/No = Yes للفواتير المدفوعة ، وهنا سيتم عرض الفواتير التي لها قيمة = No . وطبعاً في زر الدفع سيتم اضافة استعلام لتحديث قيمة هذا الحقل = Yes مع Requery للقائمة المنسدلة . أو أن التنفيذ الذي يحاول أخونا الكريم الوصول اليه هو ما يشبه نظام الطاولات في مطعم على سبيل المثال ، على اعتبار ان الطاولات هي فواتير مفتوحة ولكل فاتورة رقم تم حجزه ويحتوي بيانات ، ويتنقل بينها كيف ما يشاء وإنهاء ما يشاء حسب الإنتهاء منهم .

وعليكم السلام ورحمة الله وبركاته ,, جرب هذه الفكرة البسيطة ، في حدث بعد التحديث لمربع نص تاريخ الإجتماع :- Private Sub MeetingDate_AfterUpdate() Me.Academic_Name = Me.Text7 End Sub طبعاً هذا سيعتمد على تحديث القيم في القائمة المنسدلة بشكل تلقائي كل سنة دراسية على سبيل المثال , AcademicYear.accdb

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

أخي الكريم الأستاذ / @عبدالله بشير عبدالله السلام عليكم ورحمة الله وبركاته حفظكم الله ورعاكم؛ وسلمت يداكم على هذه الروعة؛ وعلى كل ما قدمتموه؛ وجزاكم الله خير الجزاء؛ وجعل ما قمتم به في ميزان حسناتكم. آمين رب العالمين · القائمة المنسدلة في الخلية (E5) تم تغيير مصدرها من (=AA1:AA6) إلى (=AA1:AA8) حتى يتم إضافة خلية فارغة ضمن هذه القائمة المنسدلة؛ كي أستخدمها في (تصفير) بيانات البحث؛ ولكن تم ملاحظة أن الخلية الفارغة المضافة يتم حذفها بعد النقر على زر (أنقر هنا للبحث) وكذلك الحال في كل مرة يتم إضافتها فيها فإنها تختفي تلقائيا بمجرد الضغط على زر (أنقر هنا للبحث)؛ فكيف يتم إضافة خلية فارغة ضمن القائمة المنسدلة في (E5) وتظل ثابتة ولا يتم حذفها. وتقبلوا خالص الشكر والتقدير والاحترام لشخصكم الكريم. وكل عام وأنتم بخير أخي الكريم الأستاذ / @محمد هشام. السلام عليكم ورحمة الله وبركاته حفظكم الله ورعاكم؛ وسلمت يداك على هذه الروعة؛ وعلى كل ما قدمتموه؛ وجزاكم الله خير الجزاء؛ وجعل ما قمتم به في ميزان حسناتكم. آمين رب العالمين أرجو أن يتم إضافة الرقم المسلسل لشيت (معاشات) في (ComboBox1) الخاص بالمسلسل حيث أنه يقتصر على مسلسل شيت (DATA) فقط. وتقبلوا خالص الشكر والتقدير والاحترام لشخصكم الكريم. وكل عام وأنتم بخير

السلام عليكم ورحمة الله وبركاته الأستاذة الافاضل الاخوة الأعزاء في منتدى اوفيسنا في قاعدة البيانات المرفقة وفي نموذج Meetingfrm عند ادخال تاريخ الاجتماع سوف يتم تحديث وتحديد العام الدراسي تلقائيا في مربع نص كود السنة الاكاديمية هذه العملية المطلوب تطبيقيها على مربع تحرير وسرد السنة الاكاديمية (اي عند ادخال تاريخ الاجتماع يتم اختيار العام الدراسي تلقائيا في combo box اختيار السنة الاكاديمية بدل من ان يتم اختيار العام الدراسي يدويا في هذا الكومبوبوكس ؟ ( يعني اختيار قيمة من مربع تحرير وسرد من قيمة مربع نص ) هل من الممكن ؟؟ AcademicYear.rar

وعليكم السلام ورحمة الله وبركاته اليك الكود المتاسب لطلبك Sub call1() Sheets("ff").Range("D3:U3").ClearContents Dim i As Integer For i = 1 To Sheets.Count Sheets("ff").Cells(3, 3 + i) = Sheets(i).Name Next i End Sub

لطفا المساعدة في تصليح الكود لهذا النموذج من الجدول للمدرسة في اضافة درجة القرار أصل الموضوع هنا مدرسة.rar