Moosak

وهذا برنامج أقساط مبسط جدا .. كان عبارة عن تمرين استرجاع مهارات وقتها وتحدي مع أحد الإخوة الأعزاء 😊 برنامج الأقساط - موسى.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 سنة 😂

وعليكم السلام ورحمة الله وبركاته 🙂 ربما تحتاج لتعديل تنسيق ( Format ) حقل التاريخ في النموذج بهذه الصورة : dd/mm/yyyy

وعليكم السلام ورحمة الله وبركاته أخي مصطفى 🙂 موضوعك مشابه لهذا الموضوع :

وعليكم السلام ورحمة الله وبركاته أخي حسين 🙂 تفضل الحل : وهذا أمر الترقيم ( في حال لم تضع الرقم ، سيبدأ تلقائيا من الرقم 1 ) : Dim dbs As DAO.Database Dim rst As DAO.Recordset Dim x As Double x = Nz(StartNumTxt.Value, 1) Set dbs = CurrentDb Set rst = dbs.OpenRecordset("tabol_1") ' بين القوسين اسم الجدول/ الاستعلام أو جملة السيكول rst.MoveLast rst.MoveFirst Do Until rst.EOF rst.Edit rst!id_1 = x rst.Update rst.MoveNext x = x + 1 Loop Me.Requery rst.Close Set dbs = Nothing Set rst = Nothing ترقيم تلقائي يبدأ من رقم محدد.rar