Moosak

أهلا بك أخي @nssj 🙂 هذه محاولتي فيما يخص النقطة الثانية ، بالاستعانة بالذكاء الاصطناعي 😁 وهذه هي الدالة العامة التي تفحص وجود أكثر من فقرة تبدأ بأرقام : Public Function CheckParagraphs(text As String) As Boolean Dim paragraphs() As String paragraphs = Split(text, vbCrLf) ' تقسيم النص إلى فقرات منفصلة Dim paragraph As Variant Dim x As Integer x = 0 For Each paragraph In paragraphs ' التنقل عبر كل فقرة If IsNumeric(Left(paragraph, 1)) Then ' فحص إذا كان الحرف الأول في الفقرة هو رقم x = x + 1 If x >= 2 Then CheckParagraphs = True ' لو كان الحرف الأول في الفقرة هو رقم، يتم إرجاع القيمة True Exit Function ' يتم الخروج من الدالة End If End If Next CheckParagraphs = False ' لو لم يتم العثور على فقرة تبدأ برقم، يتم إرجاع القيمة False End Function ثم يتم تحديث البيانات في الجدول عن طريق : ' Moosak : Dim dbs As DAO.Database Dim rst As DAO.Recordset Set dbs = CurrentDb Set rst = dbs.OpenRecordset("book") rst.MoveLast rst.MoveFirst Do Until rst.EOF rst.Edit rst!check_No = CheckParagraphs(rst!Nass) rst.Update rst.MoveNext Loop Me.Requery rst.Close Set dbs = Nothing Set rst = Nothing check_Book2.rar

وعليكم السلام أخي علي 🙂 جرب هذا الكود لإعادة الاتصال بقاعدة بيانات ال SQUL : Public Sub ConnectToSQL() Dim cn As ADODB.Connection Set cn = CurrentProject.Connection cn.Open "Driver={SQL Server};" & _ "Server=myServerName;" & _ "Database=myDatabaseName;" & _ "Trusted_Connection=yes;" End Sub مع مراعات تغيير بيانات الاتصال لديك في الكود

ثلث الأمثلة اللي موجودة في مكتبتي هي أمثلة من ابداعات أبو جودي 😂 معك حق أستاذي الحبيب 👍🏼🙂 إن شاء الله يتم تطويره .. ومثل ما ذكرت لك .. 😊👇

وهذا برنامج أقساط مبسط جدا .. كان عبارة عن تمرين استرجاع مهارات وقتها وتحدي مع أحد الإخوة الأعزاء 😊 برنامج الأقساط - موسى.rar

شكرا لك أخي العزيز @kkhalifa1960 جهد رائع وعمل تشكر عليه وجعله الله في ميزان حسناتك 🙂 ومثل ما قال أخي @TQTHAMI البرنامج إبداع ولكنه مزحوم جدا .. يحتاج إلى تبسيط من ناحية تقسيم الخدمات اللي يوفرها أوالألوان والأشكال والخطوط المتداخلة .. وحبذا مع شرح مبسط لكيفية الاستخدام 😊

وأنا وجدت هذا الكود في مكتبتي 🙂 (إضافة عنصر ليس موجود في القائمة ) '************ Code Start ********** ' This code was originally written by Dev Ashish. ' It is not to be altered or distributed, ' except as part of an application. ' You are free to use it in any application, ' provided the copyright notice is left unchanged. ' ' Code Courtesy of ' Dev Ashish ' Private Sub cbxAEName_NotInList(NewData As String, Response As Integer) Dim db As DAO.Database Dim rs As DAO.Recordset Dim strMsg As String strMsg = "'" & NewData & "' is not an available AE Name " & vbCrLf & vbCrLf strMsg = strMsg & "Do you want to associate the new Name to the current DLSAF?" strMsg = strMsg & vbCrLf & vbCrLf & "Click Yes to link or No to re-type it." If MsgBox(strMsg, vbQuestion + vbYesNo, "Add new name?") = vbNo Then Response = acDataErrContinue Else Set db = CurrentDb Set rs = db.OpenRecordset("tblAE", dbOpenDynaset) On Error Resume Next rs.AddNew rs!AEName = NewData rs.Update If Err Then MsgBox "An error occurred. Please try again." Response = acDataErrContinue Else Response = acDataErrAdded End If End If rs.Close Set rs = Nothing Set db = Nothing End Sub '*********** Code End **************

حسب ما علمت فعلا أن بعض الدول العربية تحضر الموقع (مصر مثلا) ، ولكن يمكن تجاوز ذلك باستخدام الشبكات الخاصة الافتراضية . 🙂

وهذا ملفك بعد تعديل الكود ليظهر النتيجة في رسالة : 🙂 الملف الجديد.rar

أخي هذا الكود النهائي بعد عدة محاولات بتغيير صيغة السؤال 🙂 ويمكن تعديل الكود أكثر ليلائم الاحتياج الفعلي ... صيغة السؤال كانت : search for a text in all records in all text type fields of all tables of access database (البحث عن نص في جميع السجلات في جميع الحقول من نوع النص لجميع جداول قاعدة البيانات) والنتيجة بتعديل بيط جدا ( والجميل في الموضوع أن الموقع يشرح لك الكود بدقة مثل ما هو واضح في الكود ) 🙂 : Public Sub SearchTextRecords(ByVal searchText As String) Dim db As DAO.Database Dim tbl As DAO.TableDef Dim fld As DAO.Field Dim rs As DAO.Recordset Set db = CurrentDb ' Loop through all tables in the database For Each tbl In db.TableDefs ' Skip system tables If Left(tbl.Name, 4) <> "MSys" Then ' Open a recordset for the table Set rs = db.OpenRecordset(tbl.Name) ' Loop through all records in the table Do While Not rs.EOF ' Loop through all fields in the table For Each fld In tbl.Fields ' Check if the field is a text type If fld.Type = dbText Then ' Search for the text in the field If InStr(rs(fld.Name).value, searchText) > 0 Then ' The text was found Debug.Print tbl.Name & ": " & fld.Name & " - " & searchText & " found :" & rs(fld.Name).value End If End If Next fld ' Move to the next record rs.MoveNext Loop ' Close the recordset rs.Close End If Next tbl Set db = Nothing End Sub الكود عبارة عن روتين عام .. ويمكن مناداته بهذه الطريقة ( يوفرها لك الموقع أيضا ) : SearchTextRecords "search text"

الله الله الله عليك يا عمر @عمر ضاحى 🙂 شكرا شكرا على المشاركة وعلى البرنامج والجهد الراااائع 🌹 الحمدلله البرنامج اشتغل بنجاح ولكنه فقط لم ينجح في الربط بقاعدة البيانات تلقائيا إلى أن ربطتها أنا بالطريقة اليدوية التقليدية 🙂 غفر الله لك ولوالديك ورضي عنكم وأرضاكم وجمعكم الله وجميع من تحب برحمته في فسيح جناته وبحبوحة رضوانه .. اللهم آمين 🙂🤲🏼

بالمناسبة اكتشفت أن الموقع يدعم اللغة العربية 👍🏼😊 كتبت له هذا السؤال : البحث عن كلمة (مفردة) معينة في جميع الحقول الموجودة في جميع الجداول في قاعدة البيانات .. وأكتب لي هذا الكود .. (نقلته لك بدون تعديل ) 🙂 : Private Sub SearchFields(ByVal searchPhrase As String) Dim db As DAO.Database Dim tbl As DAO.TableDef Dim fld As DAO.Field Dim rs As DAO.Recordset Set db = CurrentDb ' Loop through all tables in the database For Each tbl In db.TableDefs ' Skip system tables If Left(tbl.Name, 4) <> "MSys" Then ' Open a recordset for the table Set rs = db.OpenRecordset(tbl.Name) ' Loop through all fields in the table For Each fld In tbl.Fields ' Search for the phrase in the field rs.FindFirst fld.Name & " Like '*" & searchPhrase & "*'" If Not rs.NoMatch Then ' The phrase was found Debug.Print tbl.Name & "." & fld.Name & ": " & searchPhrase & " found" ' Continue searching in the field Do While Not rs.NoMatch rs.FindNext fld.Name & " Like '*" & searchPhrase & "*'" If Not rs.NoMatch Then Debug.Print tbl.Name & "." & fld.Name & ": " & searchPhrase & " found" End If Loop End If Next fld ' Close the recordset rs.Close End If Next tbl Set db = Nothing End Sub

سلطنة عمان الرائعة والجميلة 😊✌️🏻

تكرما أعد كتابة السؤال من جديد بشكل واضح ومحدد .. 🙂 مثل اسماء الحقول التي تريد البحث فيها..

وعليكم السلام ورحمة الله وبركاته أخي أحمد .. بالنسبه للغة العربية الموقع يدعم الأسئلة باللغة الانجليزية ولكن يمكنك كتابة كلمات عربية في السؤال مثل اسماء الحقول أو كلمات البحث مثلا.. وللتغلب على قضية ان تكون الاسئلة باللغة الانجليزية قم بكتابة السؤال في مترجم جوجل ثم قم بنسخة الى الموقع باللغة الانجليزية. اما بالنسبة للكود الذي سالت عنة يمكنة كتابته بكل سهولة واكثر من ذلك 😊

بالجيميل 🙂

تم بحمد الله 🙂 يمكنك الآن استخراج جميع الأرقام من جميع السجلات وإضافتها في الجدول بضغطة زر واحدة ( الزر الأصفر في الأسفل ) 🙂 وأضفت النموذج الفرعي لرؤية الأرقام المرتبطة بالسجل .. وهذه السجلات في الجدول : MZ_MNO.rar

أهلا بك أخي @nssj 🙂 بداية أشكر أخي @محب العقيدة على الموقع الرائع الذي أشار إليه في هذا الموضوع : اداة بحث ثورية 😊🌹 وقد طلبت من الموقع أن يعطيني كود يستخرج الأرقام ( فقط ) من بين هذه الأقواس {} .. من أي جملة .. وقد أعطاني هذا الكود ( قمت بعمل بعض التعديلات البسيطة وتحويله إلى دالة 🙂 ) : Public Function ExtractNumbers(text As String) As String ' This Code extract only numbers from a text if they are surrounded by these characters "{}" Dim i As Integer Dim num As String Dim result As String 'text = "The value of x is {3} and the value of y is {7}" result = "" For i = 1 To Len(text) If Mid(text, i, 1) = "{" Then ' Found the start of a number num = "" Do While Mid(text, i, 1) <> "}" ' Check if the current character is a numeric character If IsNumeric(Mid(text, i, 1)) Then num = num & Mid(text, i, 1) End If i = i + 1 Loop ' Found the end of the number, so add it to the result result = result & num & " " End If Next ' result now contains the numbers from the text, separated by spaces 'Debug.Print result ExtractNumbers = Trim(result) End Function والنتيجة رهييييييييييبة بصراحة ونااااااااااااجحة 100% 😄👌🏼 مثال بعد التطبيق : وهذه الجزئية لم أفهمها في طلبك .. 🙂 MZ_MNO.rar

مما لاحظته أن دالة التشفير الأخيرة ناقصة غير مكتملة .. وأما الأخريات جربتها وهي تعمل تمام التمام 🙂 ثم طلبت منه أن يكملها 😅 فأعطاني : ' Function to decrypt a string using the CryptoAPI Function DecryptString(CipherText As String) As String Dim Data() As Byte Dim PlainText() As Byte Dim DataLen As Long Dim PlainTextLen As Long Dim hCryptProv As Long Dim hKey As Long Dim AlgID As Long ' Convert the cipher text string to a byte array Data = StrConv(CipherText, vbFromUnicode) DataLen = UBound(Data) + 1 ' Set the encryption algorithm and key size AlgID = CALG_RC4 hKey = 0 ' Get a handle to the default encryption provider If CryptAcquireContext(hCryptProv, vbNullString, vbNullString, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) Then ' Generate a random session key If CryptGenKey(hCryptProv, AlgID, KEYLEN_256, hKey) Then ' Allocate a buffer for the plain text ReDim PlainText(DataLen) PlainTextLen = DataLen ' Decrypt the data If CryptDecrypt(hKey, 0, True, 0, PlainText(0), PlainTextLen) Then ' Convert the plain text to a string and return it DecryptString = StrConv(PlainText, vbUnicode) End If End If End If ' Release the encryption provider and key handles If hKey Then CryptDestroyKey hKey If hCryptProv Then CryptReleaseContext hCryptProv, 0 End Function

شكرا لك أخي محب العقيدة 🙂 فعلا موقع رهيييييييييييييييب جدا جدا .. جربته وهذه بعض النتائج : (1)----------------------------------------------------------------------------- سألته أن يكتب لي كود يولد نص عشوائي مختلط حروف ورموز وأرقام ، فأعطاني هذا : Function GenerateRandomString(Length As Integer) As String Dim i As Integer Dim RandomChar As String Dim RandomString As String Randomize For i = 1 To Length ' Generate a random number between 48 and 122 (ASCII values for 0-9, a-z, and A-Z) RandomChar = Chr(Int((122 - 48 + 1) * Rnd + 48)) RandomString = RandomString & RandomChar Next i GenerateRandomString = RandomString End Function وتناديه هكذا : Dim RandomString As String RandomString = GenerateRandomString(8) (2)----------------------------------------------------------------------------- سألته أن يكتب لي كود يعطيني رقم عشوائي بين رقمين .. فأعطاني هذا : RandomNumber = Int((UpperBound - LowerBound + 1) * Rnd + LowerBound) أو Dim RandomNumber As Integer Randomize RandomNumber = Int((10 - 1 + 1) * Rnd + 1) (3)----------------------------------------------------------------------------- سألته أن يكتب لي كود يقوم بتشفير النصوص وكود آخر لفك الشيفرة فأعطاني هذا : ' Function to encrypt a string using the CryptoAPI Function EncryptString(PlainText As String) As String Dim Data() As Byte Dim CipherText() As Byte Dim DataLen As Long Dim CipherTextLen As Long Dim hCryptProv As Long Dim hKey As Long Dim AlgID As Long ' Convert the plain text string to a byte array Data = StrConv(PlainText, vbFromUnicode) DataLen = UBound(Data) + 1 ' Set the encryption algorithm and key size AlgID = CALG_RC4 hKey = 0 ' Get a handle to the default encryption provider If CryptAcquireContext(hCryptProv, vbNullString, vbNullString, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) Then ' Generate a random session key If CryptGenKey(hCryptProv, AlgID, KEYLEN_256, hKey) Then ' Allocate a buffer for the cipher text ReDim CipherText(DataLen) CipherTextLen = DataLen ' Encrypt the data If CryptEncrypt(hKey, 0, True, 0, CipherText(0), CipherTextLen, DataLen) Then ' Convert the cipher text to a string and return it EncryptString = StrConv(CipherText, vbUnicode) End If End If End If ' Release the encryption provider and key handles If hKey Then CryptDestroyKey hKey If hCryptProv Then CryptReleaseContext hCryptProv, 0 End Function ' Function to decrypt a string using the CryptoAPI Function DecryptString(CipherText As String) As String Dim Data() As Byte Dim PlainText() As Byte Dim DataLen As Long Dim PlainTextLen As Long Dim hCryptProv As Long Dim hKey As Long Dim AlgID As Long ' Convert the cipher text string to a byte array Data = StrConv(CipherText, vbFromUnicode) DataLen = UBound(Data) + 1 ' Set the encryption algorithm and key size AlgID = CALG_RC4 hKey = 0 ' Get a handle to the default encryption provider If CryptAcquireContext(hCryptProv, vbNullString, vbNullString, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) Then ' Generate a random session key If CryptGenKey(hCryptProv, AlgID, KEYLEN_256, hKey) Then ' Allocate a buffer for the plain text ReDim PlainText(DataLen) PlainTextLen = DataLen ' Decrypt the data If CryptDecrypt(hKey, 0

ويمكنك استخدام السطر التالي لتحديث جميع الحقول 🙂 : CurrentDb.Execute "UPDATE TableName SET FieldName = 'النص المراد إضافته' "

مهندسنا العزيز 🙂.. من الملاحظات على المرفق .. 1ـ الأرقام من نوع Integr. يحتاج تكون Double أو عملة علشان تقبل الفواصل .. الحين البرنامج يقربها فيطلع المجموع بالزيادة .. 2ـ التاريخ ما يزيد شهر في الأقساط .. يضل يكتب تاريخ أول قسط ..

عمي جعفر وكيف تخلي الترقيم المسلسل في القائمة اليسرى يكمل على القائمة اليمنى؟ 🙂

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

شكرا لك عمي @الحلبي 🙂🌹 .. تأخرت عليك في الرد ولما رجعت وجدت كل شيء جاهز 😅 ..

لا يأس مع الحياة .. بعض الحلول تجيك بعد 14 سنة 😂