ناقل

بعد اذنك سيد @Foksh ممكن عمل ذلك عن طريق النموذج أو التقرير دون الحاجة لطريقتك هذه

مشاركة Sub ClearClipboardAndFreeMemory() ' تحرير محتوى الحافظة On Error Resume Next Dim DataObject As Object Set DataObject = CreateObject("MSForms.DataObject") DataObject.SetText "" DataObject.PutInClipboard Set DataObject = Nothing On Error GoTo 0 ' تحرير الذاكرة DoEvents Application.Echo True, "Memory cleared" End Sub

جرب هذا .... Private Sub Form_Open(Cancel As Integer) Me.OrderBy = "fega ASC" ' للفرز تصاعديًا Me.OrderByOn = True End Sub Private Sub Form_Current() Me.OrderBy = "fega ASC" ' للفرز تصاعديًا Me.OrderByOn = True End Sub

جرب واعلمنا ... لاني لم اجربه #If VBA7 Then Private Declare PtrSafe Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFileName As String) As Long Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Const HWND_BROADCAST As LongPtr = &HFFFF& #Else Private Declare Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFileName As String) As Long Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Const HWND_BROADCAST As Long = &HFFFF& #End If Private Const WM_FONTCHANGE As Long = &H1D Sub InstallFonts() Dim dbPath As String Dim fontsFolder As String Dim fontFile As String Dim fontName As String Dim fso As Object Dim folder As Object Dim file As Object Dim fontInstalled As Boolean ' الحصول على مسار قاعدة البيانات ومجلد الخطوط dbPath = CurrentProject.Path fontsFolder = dbPath & "\الخطوط" ' التحقق إذا كان مجلد الخطوط موجودًا Set fso = CreateObject("Scripting.FileSystemObject") If Not fso.FolderExists(fontsFolder) Then MsgBox "مجلد الخطوط غير موجود: " & fontsFolder, vbExclamation Exit Sub End If ' تصفح الخطوط في المجلد Set folder = fso.GetFolder(fontsFolder) For Each file In folder.Files If LCase(Right(file.Name, 4)) = ".ttf" Or LCase(Right(file.Name, 4)) = ".otf" Then fontFile = file.Path fontName = GetFontName(fontFile) ' التحقق إذا كان الخط مثبتًا fontInstalled = IsFontInstalled(fontName) If Not fontInstalled Then If AddFontResource(fontFile) > 0 Then ' تحديث النظام لإضافة الخط SendMessage HWND_BROADCAST, WM_FONTCHANGE, 0, 0 MsgBox "تم تثبيت الخط: " & fontName, vbInformation Else MsgBox "فشل في تثبيت الخط: " & fontName, vbExclamation End If End If End If Next file MsgBox "اكتمل التحقق من الخطوط.", vbInformation End Sub Function IsFontInstalled(fontName As String) As Boolean Dim regPath As String Dim objRegistry As Object On Error Resume Next regPath = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts" Set objRegistry = CreateObject("WScript.Shell") IsFontInstalled = Not IsEmpty(objRegistry.RegRead(regPath & "\" & fontName & " (TrueType)")) On Error GoTo 0 End Function Function GetFontName(fontFile As String) As String ' استرجاع اسم الملف بدون الامتداد GetFontName = CreateObject("Scripting.FileSystemObject").GetBaseName(fontFile) End Function

تفضل ... Me.Caption =DLookUp("[school]";"Tbl_basic") في حدث عند تحميل النموذج

تفضل .............. Dim UserInput As String Dim IsValid As Boolean ' احصل على النص المدخل UserInput = Me.y.Value ' تحقق من وجود حروف وأرقام فقط IsValid = Not UserInput Like "*[!A-Za-z0-9]*" And _ UserInput Like "*[A-Za-z]*" And _ UserInput Like "*[0-9]*" If IsValid Then ' أغلق النموذج إذا كان الإدخال صحيحًا DoCmd.Close Else ' إظهار رسالة خطأ MsgBox "الرقم المدخل غير صحيح. يجب أن يحتوي الإدخال على حروف وأرقام فقط.", vbCritical, "خطأ" ' تفريغ مربع النص Me.y.Value = "" End If

امين واياك ... منكم تعلمنا بارك الله فيك وفي علمك حياك اخي الكريم ... في الخدمه

جرب المرفق open.accdb Private Sub Form_Load() Call CopyText("Pa@ 12345678") End Sub Public Function CopyText(ByVal Text As Variant) As Boolean CopyText = CreateObject("htmlfile").ParentWindow.ClipboardData.SetData("Text", Text) End Function

كود VBA باستخدام Windows API وبدون تفعيل مكتبة Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal uFormat As Long, ByVal hMem As LongPtr) As LongPtr Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As LongPtr Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long Const CF_TEXT As Long = 1 Const GMEM_MOVEABLE As Long = &H2 Sub CopyToClipboard(Text As String) Dim hGlobal As LongPtr Dim lpGlobal As LongPtr ' فتح الحافظة If OpenClipboard(0&) Then ' تفريغ الحافظة EmptyClipboard ' تخصيص ذاكرة للنص hGlobal = GlobalAlloc(GMEM_MOVEABLE, Len(Text) + 1) If hGlobal Then ' قفل الذاكرة وتعبئتها بالنص lpGlobal = GlobalLock(hGlobal) If lpGlobal Then CopyMemory ByVal lpGlobal, ByVal StrPtr(Text), Len(Text) GlobalUnlock hGlobal ' نسخ النص إلى الحافظة SetClipboardData CF_TEXT, hGlobal End If End If ' إغلاق الحافظة CloseClipboard End If End Sub Private Sub Form_Load() ' نسخ النص "P@12345678" عند تحميل النموذج CopyToClipboard "P@12345678" MsgBox "تم نسخ النص إلى الحافظة!", vbInformation, "نسخ النص" End Sub ملاحظات: الكود يدعم الأنظمة 64 بت (استخدم PtrSafe و LongPtr). إذا كنت تعمل على نظام 32 بت، يمكنك استبدال LongPtr بـ Long وحذف الكلمة PtrSafe. لا يحتاج إلى مكتبات خارجية.

MSForms.DataObject يحتاج إلى تفعيل مكتبة Microsoft Forms 2.0 Object Library

تفضل .... Private Sub Form_Load() ' نسخ النص إلى الحافظة Dim clipboard As Object Set clipboard = CreateObject("MSForms.DataObject") ' النص الذي تريد نسخه clipboard.SetText "P@12345678" clipboard.PutInClipboard MsgBox "تم نسخ النص إلى الحافظة!", vbInformation, "نسخ النص" End Sub

هذا كلام الذكاء الاصطناعي ... ولم اجربه نعم، يمكن استخدام VBA (Visual Basic for Applications) في Access لإنشاء QR Code يحتوي على بيانات صورة مشفرة (مثل صيغة Base64). ومع ذلك، لأن VBA لا يحتوي على مكتبة مدمجة لتوليد QR Codes، ستحتاج إلى مكتبة خارجية لتوليد الأكواد مثل zxing أو QR Code ActiveX Control. خطوات إنشاء QR Code باستخدام VBA: 1. تحويل الصورة إلى Base64 باستخدام VBA: يمكنك تحويل الصورة إلى نص Base64 داخل VBA باستخدام مكتبة مثل Microsoft XML 6.0. Function ConvertImageToBase64(filePath As String) As String Dim objStream As Object Dim objEncoder As Object ' فتح الصورة كـ Binary Set objStream = CreateObject("ADODB.Stream") objStream.Type = 1 ' Binary objStream.Open objStream.LoadFromFile filePath ' تحويل الصورة إلى Base64 Set objEncoder = CreateObject("MSXml2.DOMDocument").createElement("b64") objEncoder.DataType = "bin.base64" objEncoder.NodeTypedValue = objStream.Read ConvertImageToBase64 = objEncoder.Text ' تنظيف الكائنات objStream.Close Set objStream = Nothing Set objEncoder = Nothing End Function 2. إنشاء QR Code باستخدام مكتبة خارجية: يمكنك استخدام مكتبة QR Code جاهزة مثل QR Code ActiveX Control أو zxing. أضف المكتبة إلى مشروع Access الخاص بك. مثال لإنشاء QR Code Sub GenerateQRCode(base64Data As String, outputPath As String) Dim qrControl As Object ' إنشاء كائن QR Code من المكتبة الخارجية Set qrControl = CreateObject("YourQRCodeLibrary.QRCode") ' إدخال بيانات الصورة بصيغة Base64 qrControl.Text = base64Data ' حفظ الكود كصورة qrControl.SaveAsImage outputPath ' تنظيف الكائنات Set qrControl = Nothing End Sub 3. دمج الخطوات: قم بقراءة الصورة وتحويلها إلى Base64 باستخدام ConvertImageToBase64. استخدم النص المشفر لتوليد QR Code باستخدام GenerateQRCode. ملاحظات: تأكد من تثبيت المكتبة اللازمة لتوليد QR Code. حجم البيانات المشفرة (Base64) يمكن أن يكون كبيرًا، مما يجعل QR Code أكثر تعقيدًا. يُفضل تقليل حجم الصور المضغوطة قبل البدء.

في حالة الكود العام ... يتم إغلاق كل عنصر موجود في النموذج مثلا ازرة وغيرها .... فلذلك خصص ما تريد إغلاقه فقط افضل

تفضل Private Sub Form_Current() Dim ctl As Control ' التحقق من قيمة الحقل MAN If Me.MAN = "HTM" Then ' اجعل جميع الحقول غير قابلة للتعديل For Each ctl In Me.Controls Select Case ctl.ControlType Case acTextBox, acComboBox, acCheckBox, acOptionGroup, acListBox, acSubform ctl.Locked = True End Select Next ctl ' السماح بتعديل الحقول الثلاثة فقط Me.INFU.Locked = False Me.MUR.Locked = False Me.POL.Locked = False Else ' إذا لم يتحقق الشرط، اغلق جميع الحقول For Each ctl In Me.Controls Select Case ctl.ControlType Case acTextBox, acComboBox, acCheckBox, acOptionGroup, acListBox, acSubform ctl.Locked = True End Select Next ctl End If End Sub أنواع الحقول المشمولة: acTextBox: الحقول النصية. acComboBox: القوائم المنسدلة. acCheckBox: حقول الاختيار (Checkbox). acOptionGroup: مجموعات الخيارات. acListBox: القوائم المتعددة. acSubform: النماذج الفرعية.

في الكود الحالي، يتم فقط تأمين الحقول النصية (TextBox) وحقول القوائم المنسدلة (ComboBox). إذا كنت تريد تضمين أنواع أخرى من الحقول، مثل حقول الاختيار (CheckBox) أو التواريخ (Date Picker) أو أي نوع آخر، يمكن تعديل الكود لتغطية جميع الأنواع المطلوبة.

جرب كده Private Sub Form_Current() Dim ctl As Control ' التحقق من قيمة الحقل MAN If Me.MAN = "HTM" Then ' اجعل جميع الحقول غير قابلة للتحرير For Each ctl In Me.Controls If ctl.ControlType = acTextBox Or ctl.ControlType = acComboBox Then ctl.Locked = True End If Next ctl ' السماح بتعديل الحقول الثلاثة فقط Me.INFU.Locked = False Me.MUR.Locked = False Me.POL.Locked = False Else ' إذا لم يتحقق الشرط، اجعل جميع الحقول غير قابلة للتعديل For Each ctl In Me.Controls If ctl.ControlType = acTextBox Or ctl.ControlType = acComboBox Then ctl.Locked = True End If Next ctl End If End Sub

هل شاهدت ما رسالة اخي محمد من صورة. gif قصدك لكل واحد منهم فرصة واحدة خلال سنتين يعني الاب فرصة والزوجة فرصة والابن فرصة

ما شاء الله تبارك الله ... كفيت و وفيت ... وننتظر صاحب الموضوع

طيب ماذا لو كان المبلغ أقل هل يحق له المنحة مرة أخرى في خلال سنتين .... يعنى لو استحق في المرة الأولى وكان المبلغ 2000 دينار وطلب منحة اخرى لعمل أيضا نظارة بمبلغ 5000 دينار هل يستحق ام لمرة واحدة فقط دون اعتبار مجموع المبالغ ب 7000 دينار

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

احسن انه في تناقض في كلامك ..... كيف برنامجك ترقيم غير مكرر وانت تتعمد اضافة سجل برقم مكرر ولا تريد رسالة الخطأ ....!!!!!!!!!! ؟؟؟؟؟ اضف السجل بدون اضافة رقم والبرنامج هو المسؤل عن الترقيم .... ثم يعيد ترتيب الارقام حسب تسلسل التاريخ ....... جرب ملفي بالطريقة التي ذكرتها لك دون ان تسجل او تغير الرقم الظاهر في مربع النص ....

مشاركة مع الاخوة ..... انظر هذا .... ADD (1).accdb

هذه مقانة عن طريق الذكاء الاصطناعي بينها والاكسس :::::: يعتبر LibreOffice Base و Microsoft Access كلاهما برامج لإدارة قواعد البيانات، إلا أن هناك فروقاً رئيسية بينهما تتعلق بمميزات كل برنامج، توافقه، تكامله مع البرمجيات الأخرى، وتكلفته. إليك أبرز الفروقات: 1. التكلفة والترخيص LibreOffice Base: مجاني ومفتوح المصدر، مما يعني أنه يمكن تحميله واستخدامه بدون تكاليف إضافية، ويتيح للمستخدمين تخصيصه وتعديله حسب احتياجاتهم. Microsoft Access: جزء من حزمة Microsoft Office التي تتطلب شراء ترخيص مدفوع، وهو برنامج مغلق المصدر. 2. التكامل والتوافق LibreOffice Base: يدعم قواعد بيانات خارجية متعددة مثل MySQL، PostgreSQL، وFirebird. قد لا يكون بنفس السلاسة مع برامج Microsoft، لكنه يعمل بشكل جيد مع التطبيقات المفتوحة المصدر. Microsoft Access: يتميز بتكامله القوي مع منتجات Microsoft الأخرى، مثل Excel وSharePoint، ويُستخدم بشكل واسع في بيئات العمل التي تعتمد على نظام Windows. كما يمكنه الاندماج بسهولة مع قواعد بيانات SQL Server وغيرها من برامج Microsoft. 3. النظام التشغيلي LibreOffice Base: يعمل على أنظمة Windows، وmacOS، وLinux، ما يجعله متعدد الأنظمة ومتوافقًا مع مختلف الأجهزة. Microsoft Access: متاح بشكل رسمي فقط على نظام Windows، وهو غير متوفر على macOS أو Linux. 4. سهولة الاستخدام وواجهة المستخدم Microsoft Access: يتميز بواجهة مستخدم متقدمة وسهلة الاستخدام للمبتدئين، وهو مجهز بأدوات ونماذج تساعد في إنشاء قواعد البيانات بسرعة. LibreOffice Base: لديه واجهة مستخدم بسيطة ومرنة، لكنها قد تكون أقل جاذبية من Access، وقد تحتاج لبعض الوقت لتعلمها خاصةً لمن اعتادوا استخدام برامج Microsoft. 5. المميزات والقدرات الوظيفية Microsoft Access: يحتوي على ميزات قوية للمستخدمين المتقدمين مثل بناء استعلامات معقدة، إنشاء تقارير مفصلة، دعم وحدات الماكرو والبرمجة باستخدام VBA، مما يجعله مناسباً للأعمال الصغيرة والمتوسطة. LibreOffice Base: يوفر ميزات أساسية مشابهة لكنه لا يدعم VBA أو وحدات الماكرو بنفس المستوى المتقدم، مما يجعله أقل قوة في بعض السيناريوهات المعقدة. ومع ذلك، فهو يكفي للاستخدامات الشخصية والمشاريع البسيطة. 6. الدعم الفني والتوثيق Microsoft Access: يحتوي على دعم فني متكامل من Microsoft، إلى جانب موارد واسعة من الوثائق، والدورات التعليمية، والمنتديات. LibreOffice Base: يعتمد بشكل أكبر على المجتمع والمصادر المفتوحة، وقد تكون هناك موارد تعليمية أقل بالمقارنة مع Access، رغم أن هناك مجتمعًا نشطًا يوفر الدعم والمساعدة. باختصار: LibreOffice Base هو خيار مناسب للأشخاص الذين يبحثون عن برنامج مجاني ومفتوح المصدر لإدارة قواعد البيانات، خاصةً إذا كانوا يعملون على أنظمة تشغيل مختلفة. أما Microsoft Access، فهو ملائم للشركات والأعمال الصغيرة التي تعتمد على نظام Windows وتحتاج إلى تكامل مع بقية منتجات Microsoft وبرمجة متقدمة.

تفضل اخي ابو الحسن @abouelhassan