ابو جودي

طبعا سوف اضع تباعا موضوع خاص لكل نقطة ويتم ربط الموضوعات بالتتابع من خلال وضع الرابط لها هنا ليكون المنتدى غنى بالموضوعات المنفصلة على وجه العموم وليكون الموضوع هنا مرجع متكامل على وجه الخصوص ملحوظة: ساعتمد فى المرفقات كذلك على ان يكون كل مرفق خاص بالفكرة او الالية التى تخصه فقط تسهيلا على الجميع لدراسة كل فكرة على حده لتحقيق الاستفادة القصوى الجزء الثانى: انتقاء المجلدات والملفات والعمليات المختلفة و المرتبطه بها >---->> من هنا

يمكن عمل ذلك من خلال استخدام الربط المتأخر (Late Binding) أو الربط المتقدم (Early Binding) وهذا يعتمد على الاحتياجات الخاصة بالتطبيق الذي تقوم بتطويره وعلى الاعتبارات التي ترغب في مراعاتها الربط المتأخر (Late Binding): المرونة: يوفر المزيد من المرونة في حال تحتاج إلى تشغيل التطبيق على إصدارات مختلفة من تطبيق Microsoft Office دون الحاجة إلى إعادة كتابة الشيفرة لا يتطلب تحديد مراجع (References) محددة والتى تختلف تبعا لاختلاف اصدار الأكسس التوافق: يسمح بالتوافق مع تطبيقات Office على أنظمة التشغيل المختلفة بشكل أفضل التحقق من وجود الكائنات: يتطلب التحقق اليدوي من وجود الكائنات أو استخدام الكائنات بدون تحقق مسبق الربط المتقدم (Early Binding): الأداء: قد يكون الربط المتقدم أسرع من الربط المتأخر لأنه يتم تحديد الكائنات في وقت التصميم وليس في وقت التشغيل التحقق التلقائي: يتيح لك IntelliSense والتحقق التلقائي في وقت الكتابة، مما يسهل استكشاف واستخدام الكائنات المتاحة الوثائق والدعم: يوفر تحديد مراجع VBA معلومات وثائق أفضل ودعمًا تلقائيًا للأوامر والخصائص الختام: إذا كنت بحاجة إلى أقصى قدر من المرونة والتوافق وليس لديك اهتمام بالتحقق التلقائي والأداء الأقصي يمكنك استخدام الربط المتأخر إذا كان الأداء والتحقق التلقائي والوثائق المفصلة هي الأمور الرئيسية قطعا سوف تفضل استخدام الربط المتقدم عند استخدام الربط المتقدم يجب أن تأخذ في اعتبارك أن توفر ملفات التعريف (المراجع) قد تتغير مع إصدارات مختلفة من تطبيقات Office لذا يجب عليك تحديثها بناءً على الإصدار الذي يتم استخدامه طيب بالنسبة لى سوف افضل الربط المتقدم (Early Binding) اسباب التفضيل : يهمنى الأداء والمرونة والسرعة وان شاء الله اقدم لكم افكار عبقرية تقدم الاستفادة القصوى دون اى عناء فى المستقبل حيث تمكنت من معالجة السلبيات ان وجدت وهى كالاتى المكتبات - تم علاج مشكلة المكتبات فى هذا الموضوع : library reference: حفظ واسترجاع المكتبات المستخدمة( وداعا لفقد المكتبات بعد اليوم ) - علاج مشكلة اعادة كتابة الاكواد مرارا وتكرارا باستخدام موديول ذكى ولماح وشاطر طيب اولا اسم الموديول : basFileUtilityKit المرجع الذى يجب التأكد من اضافته : Microsoft Office 16.0 Object Library طبعا الرقم 16.0 قد يكون 14.0 أو ....... الخ يختلف تبعا لاصدار الاكسس تم استخدام Enumerated لاضفاء المرونة هو نوع بيانات يتكون من مجموعة من القيم المسماة تسمى العناصر أو الأعضاء أو التعداد أو التعداد من النوع أسماء العداد عادة ما تكون معرفات تتصرف كثوابت في لغة البرمجه يمكن أن يُنظر إلى النوع الذي تم تعداده باعتباره اتحادًا مميزًا من نوع الوحدة الدوال داخل الموديول كالاتى ' Enumeration for the types of file dialogs Enum EnumFileDialogType msoFileDialogFilePicker = 1 msoFileDialogFolderPicker = 4 End Enum ' Enumeration for different file extensions Enum EnumFileExtensions AllFiles TextFiles ExcelFiles ImageFiles VideoFiles AudioFiles PDFFiles WordFiles ' You can add additional file extensions as needed here End Enum ' Enumeration for different options related to file paths Enum EnumOptionFile FilePathWithFileName = 1 FilePathWithoutFileName = 2 FileNameWithExtension = 3 FileNameWithoutExtension = 4 FileExtensionOnly = 5 End Enum Public ChosenFilePaths() As String Dim TempChosenFilePaths() As String ' Check if the Microsoft Office Object Library is referenced ' Make sure to go to Tools > References and select the appropriate version ' e.g., "Microsoft Office 16.0 Object Library" for Office 2016 ' Function to open the file dialog and return the selected file paths Function GetFileDialog(Optional ByVal EnumFileExtension As EnumFileExtensions = AllFiles, Optional ByVal AllowMultipleFiles As Boolean = False) As Variant Dim i As Integer Dim fileDialogObject As Object Dim FilePaths() As String ' Use TempChosenFilePaths as a temporary storage ReDim TempChosenFilePaths(1 To 1) Set fileDialogObject = Application.FileDialog(EnumFileDialogType.msoFileDialogFilePicker) With fileDialogObject .Title = "Select File" .AllowMultiSelect = AllowMultipleFiles .Filters.Clear ' Adding filters based on the selected file extension Select Case EnumFileExtension Case EnumFileExtensions.AllFiles .Filters.Add "All Files", "*.*" Case EnumFileExtensions.TextFiles .Filters.Add "Text Files", "*.txt" Case EnumFileExtensions.ExcelFiles .Filters.Add "Excel Files", "*.xlsx; *.xls" Case EnumFileExtensions.ImageFiles .Filters.Add "Image Files", "*.jpg; *.jpeg; *.png; *.gif" Case EnumFileExtensions.VideoFiles .Filters.Add "Video Files", "*.mp4; *.avi; *.mov" Case EnumFileExtensions.AudioFiles .Filters.Add "Audio Files", "*.mp3; *.wav; *.ogg" Case EnumFileExtensions.PDFFiles .Filters.Add "PDF Files", "*.pdf" Case EnumFileExtensions.WordFiles .Filters.Add "Word Files", "*.docx; *.doc" ' You can add additional file extensions as needed here End Select If .Show = -1 Then ' ReDim the array to the number of selected items ReDim FilePaths(1 To .SelectedItems.Count) ' Populate the array with selected item paths For i = 1 To .SelectedItems.Count FilePaths(i) = .SelectedItems(i) ' Add to TempChosenFilePaths TempChosenFilePaths(UBound(TempChosenFilePaths)) = FilePaths(i) ReDim Preserve TempChosenFilePaths(1 To UBound(TempChosenFilePaths) + 1) Next i ' Return the array GetFileDialog = JoinFilePaths(FilePaths) ' Update ChosenFilePaths with the temporary values ChosenFilePaths = TempChosenFilePaths ' Clear TempChosenFilePaths Erase TempChosenFilePaths Else ' Return an empty string if no file is selected GetFileDialog = "" End If End With ' Set file dialog object to nothing Set fileDialogObject = Nothing End Function ' Function to join paths and set them to the global variable Function JoinFilePaths(paths() As String) As String JoinFilePaths = Join(paths, vbCrLf) End Function ' Function to check if ListBox contains a specific item Function ListBoxContainsItem(listBox As Object, item As String) As Boolean Dim i As Integer ListBoxContainsItem = False For i = 0 To listBox.ListCount - 1 If listBox.Column(0, i) = item Then ListBoxContainsItem = True Exit Function End If Next i End Function ' Subroutine to add paths to ListBox in the form Sub AddToFormListBox(frm As Object, paths() As String, ListBoxName As String, Optional ClearListBox As Boolean = True) Dim i As Integer Dim listBoxControl As Object ' Check if frm is not Nothing If Not frm Is Nothing Then ' Check if ListBox with the specified name exists in the form's controls On Error Resume Next Set listBoxControl = frm.Controls(ListBoxName) On Error GoTo 0 ' If ListBox control exists, add or clear items If Not listBoxControl Is Nothing Then ' Clear ListBox if ClearListBox is True If ClearListBox Then listBoxControl.RowSource = "" End If ' Add unique non-empty items to ListBox For i = LBound(paths) To UBound(paths) If Trim(paths(i)) <> "" And Not ListBoxContainsItem(listBoxControl, paths(i)) Then listBoxControl.AddItem paths(i) End If Next i Else ' Handle the case where ListBox control does not exist MsgBox "ListBox with name '" & ListBoxName & "' not found in the form.", vbExclamation End If End If End Sub ' Subroutine to add paths to Access table Sub AddToAccessTable(tableName As String, paths() As String) Dim db As DAO.Database Dim rs As DAO.Recordset Dim i As Integer Dim filePath As String ' Open the database Set db = CurrentDb ' Open the table Set rs = db.OpenRecordset(tableName, dbOpenDynaset) ' Add each non-empty and non-duplicate path to the table For i = LBound(paths) To UBound(paths) filePath = Trim(paths(i)) ' Check if the path does not already exist in the table If filePath <> "" And DCount("*", tableName, "FilePath='" & filePath & "'") = 0 Then rs.AddNew rs.Fields("FilePath").Value = filePath rs.Update End If Next i ' Close the recordset and database rs.Close Set rs = Nothing Set db = Nothing End Sub ' Function to open the folder dialog and return the selected folder path Function GetFolderDialog() As String Dim folderDialogObject As Object Set folderDialogObject = Application.FileDialog(EnumFileDialogType.msoFileDialogFolderPicker) With folderDialogObject .Title = "Select Folder" .AllowMultiSelect = False .Show End With If folderDialogObject.SelectedItems.Count > 0 Then GetFolderDialog = folderDialogObject.SelectedItems(1) Else ' Handle the case where no folder is selected MsgBox "No folder selected.", vbExclamation GetFolderDialog = "" End If Set folderDialogObject = Nothing End Function ' Function to get the desired option for a file path Function GetFileOption(ByRef filePath As String, Optional ByRef EnumOptionFile As EnumOptionFile = FilePathWithFileName) As String ' Check if the file exists If FileExists(filePath) Then ' Get file File Option using GetFileOption function Select Case EnumOptionFile Case FilePathWithoutFileName GetFileOption = Left(filePath, InStrRev(filePath, "\")) Case FilePathWithFileName GetFileOption = filePath Case FileNameWithExtension GetFileOption = Mid(filePath, InStrRev(filePath, "\") + 1) Case FileExtensionOnly GetFileOption = Right(filePath, Len(filePath) - InStrRev(filePath, ".")) Case FileNameWithoutExtension GetFileOption = Mid(filePath, InStrRev(filePath, "\") + 1, InStrRev(filePath, ".") - InStrRev(filePath, "\") - 1) End Select Else ' Return an empty string if the file does not exist GetFileOption = "" End If End Function ' Function to get additional information about a file Function GetFileInfo(filePath As String) As String ' Check if the file exists If FileExists(filePath) Then ' Get file information using GetFileInfo function Dim fileInfo As String fileInfo = "File Information:" & vbCrLf fileInfo = fileInfo & "Path: " & filePath & vbCrLf fileInfo = fileInfo & "Size: " & FileLen(filePath) & " bytes" & vbCrLf fileInfo = fileInfo & "Created: " & FileDateTime(filePath) & vbCrLf GetFileInfo = fileInfo Else ' Return an empty string if the file does not exist GetFileInfo = "" End If End Function ' Function to create a new folder Function CreateNewFolder(parentPath As String, folderName As String) As String Dim newFolderPath As String newFolderPath = parentPath & "\" & folderName MkDir newFolderPath CreateNewFolder = newFolderPath End Function ' Function to check if a file exists Function FileExists(ByVal filePath As String, Optional findFolders As Boolean = False) As Boolean Const vbReadOnly As Long = 1 Const vbHidden As Long = 2 Const vbSystem As Long = 4 Const vbDirectory As Long = 16 Dim attributes As Long attributes = (vbReadOnly Or vbHidden Or vbSystem) If findFolders Then attributes = (attributes Or vbDirectory) ' Include folders as well. Else ' Strip any trailing slash, so Dir does not look inside the folder. Do While Right(filePath, 1) = "\" filePath = Left(filePath, Len(filePath) - 1) Loop End If ' If Dir() returns something, the file exists. FileExists = (Len(Dir(filePath, attributes)) > 0) End Function من خلال تلك الوحدة النمطية يمكن عمل الاتى 1- انتقاء مسار مجلد من خلال الدالة : GetFolderDialog الاستدعاء: GetFolderDialog 2- انتقاء مسار ملف / ملفات من خلال الدالة : GetFileDialog الاستدعاء:GetFileDialog(EnumFileExtensions, AllowMultipleFiles) -قائمة EnumFileExtensions التى تضفى مرونة فى تحديد نوع الملفات التى تريد انتقائها - AllowMultipleFiles تحديد ما اذا كنت تريد انتقاء ملف واحد فقط لتكون False , أو ملفات متعددة لتكون True 3-استخلاص معلومات الملف من خلال الدالة : GetFileInfo الاستدعاء:GetFileInfo(filePath) 4- التحكم فى خيارات الملف / الملفات من خلال الدالة : GetFileOption وهى (المسار كاملا مع اسم الملف , مسار الملف فقط , اسم الملف مع الامتداد فقط , امتداد الملف فقط ) الاستدعاء:GetFileOption(filePath , EnumOptionFile) 5- اضافة مسار الملف / الملفات الذى يتم انتقاءه كاملا او حسب ما تريد من الخطوة الرابعة السابقة الى مربع قائمة وذلك من خلال الدالة : AddToFormListBox الاستدعاء: 6- اضافة مسار الملف / الملفات الذى يتم انتقاءه كاملا او حسب ما تريد من الخطوة الرابعة الى جدول من خلال الدالة: AddToAccessTable الاستدعاء: يتبع...... FileDialog.accdb

السلام عليكم ورحمة الله تعالى وبركاته انا بصدد تصميم قاعدة بيانات فى عملى وتباعا ان شاء الله اضع بين اياديكم خلاصة مجهود وتعليم سنوات اولا تسجيل الاخطاء ومعالجتها اولا موديول باسم : basErrorHandling Public strProcessName As String ' The name of the table where errors are logged Public Const TABLE_ERROR_LOG_NAME As String = "tblErrorLog" ' Subroutine to log errors in the error log table Sub ErrorLog(ByVal intErrorNumber As Integer, ByVal strErrorDescription As String, ByVal strErrorProcessName As String) On Error GoTo Err_ErrorLog Dim strErrorMsg As String strErrorMsg = "Error " & intErrorNumber & ": " & strErrorDescription ' Show a message to the user MsgBox strErrorMsg, vbQuestion, strErrorProcessName ' Log error details in the error log table With CurrentDb.OpenRecordset(TABLE_ERROR_LOG_NAME) .AddNew ![ErrorNumber] = intErrorNumber ![ErrorDescription] = Left$(strErrorDescription, 255) ![ErrorProcessName] = strErrorProcessName ![ErrorDate] = Now() ![userName] = GetLoggedUserName() .Update .Close End With Exit_ErrorLog: Exit Sub Err_ErrorLog: ' Error message in case of an unexpected issue strErrorMsg = "An unexpected situation arose in your program." & vbNewLine strErrorMsg = strErrorMsg & "Please write down the following details:" & vbNewLine & vbNewLine strErrorMsg = strErrorMsg & "Calling Proc: " & strErrorProcessName & vbNewLine strErrorMsg = strErrorMsg & "Error Number " & intErrorNumber & vbNewLine & strErrorDescription & vbNewLine & vbNewLine strErrorMsg = strErrorMsg & "Unable to record because Error " & Err.Number & vbNewLine & Err.Description & vbNewLine strErrorMsg = strErrorMsg & "Occurred at Line: " & Erl MsgBox strErrorMsg, vbCritical, "ErrorLog()" Resume Exit_ErrorLog End Sub ' Subroutine to handle and log errors ' This subroutine checks for errors and logs them using the ErrorLog function. ' It clears the error after logging it. ' Parameters: ' - strProcName: The name of the procedure where the error occurred. Public Sub HandleAndLogError(ByVal strProcName As String) ' Check for errors If Err.Number <> 0 Then ' Handle the error and log it Call ErrorLog(Err.Number, Err.Description, strProcName) ' Clear the error Err.Clear End If End Sub ' Function to get the logged username, or return "N/A" if not available Function GetLoggedUserName() As String On Error Resume Next Dim userName As String userName = Environ("USERNAME") If Err.Number <> 0 Then userName = "N/A" Err.Clear End If On Error GoTo 0 GetLoggedUserName = userName End Function ---------------------------------------------------------------------- ثانيا مويدول باسم : basInitialization ' The name of the table where errors are logged Public Const TABLE_ERROR_LOG_NAME As String = "tblErrorLog" ' Subroutine to initialize the application Sub InitializeApplication() ' Initialize the error log table if it doesn't exist If Not IsErrorLogTableInitialized() Then CreateErrorLogTable End Sub ' Check if the error log table exists and is initialized Function IsErrorLogTableInitialized() As Boolean Dim db As DAO.Database Dim rs As DAO.Recordset ' Use error handling to check if the error log table exists On Error Resume Next Set db = CurrentDb Set rs = db.OpenRecordset(TABLE_ERROR_LOG_NAME) On Error GoTo 0 ' Check if the error log table is initialized (contains necessary fields) If Not rs Is Nothing Then On Error Resume Next rs.MoveFirst IsErrorLogTableInitialized = (Err.Number = 0) And (rs.Fields.Count >= 6) On Error GoTo 0 rs.Close End If Set rs = Nothing Set db = Nothing End Function ' Subroutine to create the error log table Sub CreateErrorLogTable() On Error Resume Next Dim db As DAO.Database Set db = CurrentDb ' Check if the table already exists If Not IsTableExists(TABLE_ERROR_LOG_NAME, db) Then ' Define the SQL code to create the table Dim strSQL As String strSQL = "CREATE TABLE " & TABLE_ERROR_LOG_NAME & " (" & _ "ID AUTOINCREMENT PRIMARY KEY, " & _ "ErrorProcessName TEXT(255), " & _ "ErrorNumber LONG, " & _ "ErrorDescription MEMO, " & _ "ErrorDate DATETIME, " & _ "UserName TEXT(255));" ' Execute the SQL command to create the table directly DoCmd.RunSQL strSQL End If Set db = Nothing On Error GoTo 0 End Sub ' Function to check if a table exists in the database Function IsTableExists(tableName As String, Optional db As DAO.Database) As Boolean ' Use DLookup to check for the existence of the table in MSysObjects On Error Resume Next Set db = IIf(db Is Nothing, CurrentDb, db) IsTableExists = Not IsNull(DLookup("Name", "MSysObjects", "Name='" & tableName & "'")) On Error GoTo 0 End Function وظيفة الموديول هو تهئة ما اريد لقاعدة البيانات البدء به ومن خلاله ---------------------------------------------------------------------- 3- نموذج البداية وليكن الان باسم frmInitialization وفى حدث عند التحميل نضع الكود الاتى Private Sub Form_Load() strProcessName = "Form Load : frmIntialization" On Error Resume Next ' Initialize the application when the startup form is loaded. InitializeApplication ' Add calls to the initialized special functions through which you want the database to be booted ' Or add specify the codes through which you would like to process the data later according to the requirements of your design ' Set the current procedure name (you can adjust the procedure name as needed) If Err.Number <> 0 Then ' Handle the error (display a message) Call ErrorLog(Err, Error$, strProcessName) ' Clear the error Err.Clear End If End Sub النتيجة المرغوب فى الخصول عليها : عند تشغيل القاعدة فى المرة الأولى تنشئ جدول تسجيل الأخطاء من تلقاء نفسها باسم الروتين او الحدث ورقم الخطاء والوصف المتطلبات عند اعداد الاكواد تباعا نمرر اسم الروتين من خلال المتغير strProcessName كما فعلت فى الحدث السابق للنموذج: strProcessName = "Form Load : frmIntialization" لو حدث اى خطأ مستقبلا سوف يتم تسجيله حتى يستطيع مطور النظم او القائم على اعمال صيانة قواعد البيانات او المصمم معرفة مكان حدوث الخطأ الشق الثانى نقوم بعمل الايقاف للاخطا ليستكمل الكود عمله حتى لو وجودت اى اخطاء من خلال : On Error Resume Next بعد كتابة الكود كما نريد وبعد ان ننتهى منه نضع الشرط التالى : If Err.Number <> 0 Then بذلك نضع شرط عند الدوران على الكود لتنفيذه فى حالة وجود خطأ اولا اظهر رسالة الخطأ حتى يعلم المستخدم سبب المشكلة ثم استدعى الدالة لتسجيل هذا الخطأ ويتم ذلك من خلال Call ErrorLog(Err, Error$, strProcessName) الان هذه بداية احترافية وعلى اسس صحيحة ومفيدة للمستقبل ..... يتبع HandleAndLogError.accdb

السلام عليكم ورحمة الله وبركاته استاذى الجليل ومعلمى القدير و والدى الحبيب الاستاذ @ابوخليل والله اشتقنا فضلا وكرما ممكن حضرتك تعمل ملف تنفيذى يخص قاعدة بيانات باسم >>--> RunApp.Accde لان فعلا حاولت عمل الملف ولكن حماية ويندوز تراه تهديا ويتم حذف الملف تلقائيا بعكس الملف بتاع حضرتك

وعليكم السلام ورحمة الله وبركاته :: 🌼 شكر وتقدير لحضرتك على هذه الروائع🌼 :: واسمح لى المره دى 😀 يضاف للمكتبة العامرة

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

العفو يا دكتور جزاكم الله خيرا انا اقل طويلب علم يا دكتور الشكر لله تعالى والحمد لله تعالى الذى هدانا وما كنا لنهتدى لولا ان هدانا الله عزوجل

بفضل استخدام استعلام لحساب المجاميع ثم الربط بينه وبين النتائح على حسب فهمى من الكود بتاعك جرب الاستعلام بالشكل ده SELECT numberzabonn, SUM(bagy) + SUM(danadaen) AS enddaenTotal FROM conform_zabon GROUP BY numberzabonn;

اتفضل يا دكتور المرفق وبه 4 استعلامات تدلل واختر ما يلبى رغباتك الاكثر بيع.accdb

طب انا اضفت لك مرفق فى الرد السابق شوف كده يا دكتور هل تم تحقيق الطلب فى احد الاستعلامات ال 3

طيب افتح الاستعلامات فى وضع التصميم وضع الكود الاتى فى Sql SELECT TOP 1 itemname, SUM(itemqty) AS TotalSalesQuantity FROM t1 GROUP BY itemname ORDER BY SUM(itemqty) DESC; اعمل استعلام جديد وفى وضع التصميم Sql ضع الكود الاتى SELECT t1.itemname, Count(*) AS SalesCount FROM t1 GROUP BY t1.itemname ORDER BY Count(*) DESC; اعمل استعلام جديد وفى وضع التصميم Sql ضع الكود الاتى SELECT t1.itemname, Count(*) AS SalesCount, Sum(t1.itemqty) AS TotalSalesQuantity FROM t1 GROUP BY t1.itemname ORDER BY Count(*) DESC; اعمل استعلام جديد وفى وضع التصميم Sql ضع الكود الاتى SELECT t1.itemname, Count(*) AS SalesCount, Sum(t1.itemqty) AS TotalSalesQuantity FROM t1 GROUP BY t1.itemname ORDER BY Sum(t1.itemqty) DESC;

الاكثر بيعا استخدم الاستعلام التالى SELECT TOP 1 t1.itemname, Count(*) AS SalesCount FROM t1 GROUP BY t1.itemname ORDER BY Count(*) DESC; انا مش فاهم الشطر الثانى من السؤال يا دكتور ممكن توضيح اكثر

طيب يا استاذه @safaa salem5 المرفق شغال مع حضرتك تمام واللا فى مشاكل ؟ وهل ده المطلوب واللا لا

طيب الكود طبعا لم ولن استطيع التجربة ولكن وجدت هذا الشرح ودى الترجمة اللى انا فهمتها لفعل ذلك، يمكنك استخدام خدمة تحويل الصوت إلى نص مثل Azure Speech Services أو Google Cloud Speech-to-Text. يجب أن يكون لديك مفاتيح API الخاصة بك من Google Cloud لتنفيذ هذا الكود. تحتاج إلى إضافة مربع نص (TextBox) في نموذج Access للعرض النص المحول من الصوت. قم بإضافة المرفق النموذجي لـ Microsoft XML (MSXML) إلى المراجع (References) في VBA. استخدم الكود التالي في VBA: Sub ConvertSpeechToText() Dim apiKey As String Dim audioFilePath As String Dim textBoxName As String Dim accessToken As String Dim xhr As Object Dim responseText As String ' Set your Google Cloud API key apiKey = "Your_Google_Cloud_API_Key" ' Set the path to the audio file (recorded audio file) audioFilePath = "C:\Path\To\Your\Audio\File.wav" ' Name of the text box where you want to display the text textBoxName = "txtSpeechToText" ' Get the access token accessToken = GetGoogleCloudAccessToken(apiKey) ' Create XMLHTTP object Set xhr = CreateObject("MSXML2.ServerXMLHTTP.6.0") ' Configure the request xhr.Open "POST", "https://speech.googleapis.com/v1/speech:recognize?key=" & apiKey, False xhr.setRequestHeader "Content-Type", "application/json" ' Configure the request body xhr.send "{""config"": {""encoding"": ""LINEAR16"", ""sampleRateHertz"": 16000, ""languageCode"": ""en-US""}, ""audio"": {""content"": """ & Base64Encode(audioFilePath) & """}}" ' Read the response responseText = xhr.responseText ' Parse the response and extract the text Dim jsonResponse As Object Set jsonResponse = JsonConverter.ParseJson(responseText) Dim recognizedText As String recognizedText = jsonResponse("results")(1)("alternatives")(1)("transcript") ' Display the text in the text box Forms("YourFormName").Controls(textBoxName).Value = recognizedText ' Close objects Set xhr = Nothing Set jsonResponse = Nothing End Sub Function GetGoogleCloudAccessToken(apiKey As String) As String Dim xhr As Object Set xhr = CreateObject("MSXML2.ServerXMLHTTP.6.0") xhr.Open "POST", "https://www.googleapis.com/oauth2/v4/token", False xhr.setRequestHeader "Content-Type", "application/x-www-form-urlencoded" xhr.send "grant_type=urn%3Aietf%3Aparams%3Aoauth%3Agrant-type%3Aapikey&key=" & apiKey Dim jsonResponse As Object Set jsonResponse = JsonConverter.ParseJson(xhr.responseText) GetGoogleCloudAccessToken = jsonResponse("access_token") Set xhr = Nothing Set jsonResponse = Nothing End Function Function Base64Encode(filePath As String) As String Dim stream As Object Set stream = CreateObject("ADODB.Stream") stream.Type = 1 ' adTypeBinary stream.Open stream.LoadFromFile filePath Base64Encode = Convert.ToBase64String(stream.Read) Set stream = Nothing End Function

الصوت ل كتابة واللا الكتابة لصوت ؟ وايه نوع الكتابة يعنى كلمات ثابته زاللا متغيرة ياريت توضيح اكثر لوضع افضل تصور طبقا لذلك التوضيح

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

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

الموضوع تعبنى جدا والله وكان تحدى صعب احب التنويه الى شئ استخدام sleep اثناء العمل قد يصيب الأكسس بالتجميدوالشلل وقد يعلق فى الذاكرة ولذلك ابتعدت عن ضبط الاكواد من خلالها واليكم نتيجة التحدى اولا تم مراعاة وضع الاكواد فى وحدة نمطية ليتم استخدامها فى اكثر من نموذج حتى لو اختلف وتعددت الوان أزرار الأوامر ومهما اختلفت اسماء او عناوين الأزرار وفى حاجة كمان لو عاوزيين نلون لون الزرار بالاصفر بس ومنغيرش تسمية عنصر التسمية ممكن جدا جدا ومن نفس الكود يعنى كود ذكى وابن حلال وبيقدر يفهمنا من أول تكه على الزرار اه والله زيمبئولكم كده.. شغل فاخر من الاخر اومااااااااااال 1- أكواد الوحدة النمطية Option Compare Database Option Explicit ' Constant that specifies the time interval for color flashing (in seconds) Const dblTimeInterval As Double = 0.5 ' Constant that determines the number of times the colors will flash Const intFlashCount As Integer = 5 ' Variable to track whether Label flashing should occur Public AllowFlashing ' Public variables to store default values Public btnControlDefaultColor As Long Public lblControlDefaultColor As Long Public strLblControlCaption As String Public formIsClosing As Boolean ' Public variable to store the selected button Public selectedButton As CommandButton ' Function to return the highlighted color Function ApplyHighlighted() As Long ApplyHighlighted = RGB(255, 255, 0) End Function ' Subroutine to set the button color Sub ButtonColor(ByVal frm As Form, Optional btn As CommandButton = Nothing, Optional DisableLabelChange As Boolean) ' Set the default button color if not highlighted If Not btn Is Nothing Then If btn.BackColor <> ApplyHighlighted Then btnControlDefaultColor = btn.BackColor ' Clear the previous button's highlight If Not selectedButton Is Nothing Then selectedButton.BackColor = btnControlDefaultColor End If ' Set the new button as selected and highlight it btn.BackColor = ApplyHighlighted ' Save the caption of the current button If Not DisableLabelChange Then strLblControlCaption = btn.Caption End If Set selectedButton = btn End If End Sub ' Subroutine to flash the label control Sub FlashLabelControl(frm As Form, lblControl As Object, DisableLabelChange As Boolean) On Error GoTo ErrorHandler Dim flashingColor As Long Dim flashingInterval As Single Dim flashCount As Integer Dim flashTimer As Single Dim i As Integer On Error GoTo 0 ' Turn off error trapping. On Error Resume Next ' Defer error trapping. ' Set the default label color if not highlighted If lblControl.BackColor <> ApplyHighlighted Then lblControlDefaultColor = lblControl.BackColor flashingColor = ApplyHighlighted flashingInterval = dblTimeInterval flashCount = intFlashCount ' Reset the label color to the default when the form is loaded If TypeOf lblControl Is Access.Label And Not formIsClosing Then lblControl.BackColor = lblControlDefaultColor If Not DisableLabelChange Then lblControl.Caption = strLblControlCaption End If End If flashTimer = Timer + flashingInterval ' Flash the label color For i = 1 To flashCount Do While Timer < flashTimer And Not formIsClosing DoEvents Loop ' Update the label color during the flash If TypeOf lblControl Is Access.Label And Not formIsClosing Then If AllowFlashing Then ' Check the AllowLabelCaptionChange value to determine whether to change the caption If Not DisableLabelChange Then lblControl.Caption = IIf(lblControl.Caption = strLblControlCaption, strLblControlCaption, vbNullString) End If lblControl.BackColor = IIf(lblControl.BackColor = lblControlDefaultColor, flashingColor, lblControlDefaultColor) End If End If ' Update the flash timer flashTimer = Timer + flashingInterval Next i ' Reset the label color to the default after flashing If TypeOf lblControl Is Access.Label And Not formIsClosing Then lblControl.BackColor = lblControlDefaultColor If Not DisableLabelChange Then lblControl.Caption = strLblControlCaption End If End If ' 2467 Err.Clear ' Clear Err Exit Sub ' Exit to avoid handler. ErrorHandler: ' Error-handling routine. Select Case Err.Number ' Evaluate error number. Case Is = 2467 flashCount = 0 flashTimer = 0 Exit Sub ' Exit to avoid handler. Case Else ' Handle other situations here... MsgBox Err.Number & ": " & Err.Description Resume ' Resume execution at the same line End Select End Sub ' Subroutine to change the button color and control Label flashing Sub ChangeCommandButtonColor(frm As Form, Optional lblControl As Object, Optional DisableLabelChange As Boolean) On Error GoTo ErrorHandler Dim clickedButton As CommandButton Set clickedButton = frm.ActiveControl On Error GoTo 0 ' Turn off error trapping. On Error Resume Next ' Defer error trapping. ' Clear the previous button's highlight If Not selectedButton Is Nothing Then selectedButton.BackColor = btnControlDefaultColor lblControl.Caption = "" strLblControlCaption = "" End If ' Set the new button as selected and highlight it Set selectedButton = clickedButton ' Update the label caption If Not DisableLabelChange Then strLblControlCaption = clickedButton.Caption End If ' Apply the button color and control Label flashing ButtonColor frm, clickedButton, True ' Check if lblControl is provided and is a valid object If Not lblControl Is Nothing Then AllowFlashing = Not DisableLabelChange ' Determine whether to trigger flashing lblControl.Caption = strLblControlCaption FlashLabelControl frm, lblControl, False End If Err.Clear ' Clear Err Exit Sub ' Exit to avoid handler. ErrorHandler: ' Error-handling routine. Select Case Err.Number ' Evaluate error number. Case Is = 5 Exit Sub ' Exit to avoid handler. Case Else ' Handle other situations here... MsgBox Err.Number & ": " & Err.Description Resume ' Resume execution at the same line End Select End Sub 2- الاكواد للاستخدام من خلال النموذج ولا اسهل من كده.. يا عينى ع الدلع Private Sub Form_Load() formIsClosing = False End Sub Private Sub Form_Close() formIsClosing = True End Sub Private Sub Command1_Click() ' Call the ChangeCommandButtonColor subroutine with the current form and label control (lblDisplayTitle). ChangeCommandButtonColor Me, Me.lblDisplayTitle End Sub Private Sub Command2_Click() ' Call the ChangeCommandButtonColor subroutine with the current form and label control (lblDisplayTitle). ChangeCommandButtonColor Me, Me.lblDisplayTitle End Sub Private Sub Command3_Click() ' Call the ChangeCommandButtonColor subroutine with the current form and label control (lblDisplayTitle). ChangeCommandButtonColor Me, Me.lblDisplayTitle End Sub Private Sub Command4_Click() ' Call the ChangeCommandButtonColor subroutine with the current form and label control (lblDisplayTitle). ChangeCommandButtonColor Me, Me.lblDisplayTitle End Sub Private Sub Command5_Click() ' Call the ChangeCommandButtonColor subroutine with the current form only without label control (lblDisplayTitle). ' To disable Allow Label Caption Change = True ChangeCommandButtonColor Me, Me.lblDisplayTitle, True End Sub معلش انا شرحت كل شئ ع الأكواد بالانجليزى طبعا مش فلسفة علشان عارف انت هتقول ايه سامعك... علشان العربى بيعمل مشاكل فى الاعدادت الاقليمية للغة لو مكانت مضبوطه بس خلاص • وأخيرا المرفق FlashLabel.accdb

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

السلام عليكم ورحمة الله تعالى وبركاته بارك الله فى اساتذتى الكرام كفو ووفو وما قصرو وزيادة فى الخير اضع حل بعد مواجعتى لمشكلة فى هذه النفصطة عند التعامل مع ملفات الاكسل بسبب اختلاف النسخ والتسيق لملفات الاكسل تبعا لاختلاف الاصدارات اليكم الخطوات 1- انشاء وحدة نمطية عامة ليسهل استخدامها فى شتى زوايا التطبيق واعطها الاسم التالى basFileUtilityKit وضع بها هذا الكود ' Enumeration for the types of file dialogs Enum EnumFileDialogType msoFileDialogFilePicker = 1 msoFileDialogFolderPicker = 4 End Enum ' Enumeration for different file extensions Enum EnumFileExtensions AllFiles TextFiles ExcelFiles ImageFiles VideoFiles AudioFiles PDFFiles WordFiles ' You can add additional file extensions as needed here End Enum ' Enumeration for different options related to file paths Enum EnumOptionFile DirectoryWithoutFileName DirectoryWithFileName FileNameWithExtension FileNameWithoutExtension ExtensionOnly End Enum ' Function to open the folder dialog and return the selected folder path Function GetFolderDialog() As String On Error Resume Next Dim folderDialogObject As Object Set folderDialogObject = Application.FileDialog(EnumFileDialogType.msoFileDialogFolderPicker) With folderDialogObject .Title = "Select Folder" .AllowMultiSelect = False .Show End With If folderDialogObject.SelectedItems.Count > 0 Then GetFolderDialog = folderDialogObject.SelectedItems(1) Else ' Handle the case where no folder is selected MsgBox "No folder selected.", vbExclamation GetFolderDialog = "" End If Set folderDialogObject = Nothing On Error GoTo 0 End Function ' Function to open the file dialog and return the selected file path Function GetFileDialog(ByVal EnumFileExtension As EnumFileExtensions) As String On Error Resume Next ' Check if the Microsoft Office Object Library is referenced ' Make sure to go to Tools > References and select the appropriate version ' e.g., "Microsoft Office 16.0 Object Library" for Office 2016 Dim fileDialogObject As Object Set fileDialogObject = Application.FileDialog(EnumFileDialogType.msoFileDialogFilePicker) With fileDialogObject .Title = "Select File" .AllowMultiSelect = False .Filters.Clear ' Adding filters based on the selected file extension Select Case EnumFileExtension Case EnumFileExtensions.AllFiles .Filters.Add "All Files", "*.*" Case EnumFileExtensions.TextFiles .Filters.Add "Text Files", "*.txt" Case EnumFileExtensions.ExcelFiles .Filters.Add "Excel Files", "*.xlsx; *.xls" Case EnumFileExtensions.ImageFiles .Filters.Add "Image Files", "*.jpg; *.jpeg; *.png; *.gif" Case EnumFileExtensions.VideoFiles .Filters.Add "Video Files", "*.mp4; *.avi; *.mov" Case EnumFileExtensions.AudioFiles .Filters.Add "Audio Files", "*.mp3; *.wav; *.ogg" Case EnumFileExtensions.PDFFiles .Filters.Add "PDF Files", "*.pdf" Case EnumFileExtensions.WordFiles .Filters.Add "Word Files", "*.docx; *.doc" ' You can add additional file extensions as needed here End Select .Show End With If fileDialogObject.SelectedItems.Count > 0 Then GetFileDialog = fileDialogObject.SelectedItems(1) Else ' Handle the case where no file is selected MsgBox "No file selected.", vbExclamation GetFileDialog = "" End If Set fileDialogObject = Nothing Exit Function If Err.Number <> 0 Then Select Case Err.Number Case 3078: Resume Next ' Ignore error if user cancels the file dialog Case 0: Resume Next Case Else ' Call ErrorLog(Err.Number, Error$, strProcessName) End Select ' Clear the error Err.Clear End If End Function ' Function to get the desired option for a file path Function GetFileOption(ByRef strFilePath As String, Optional ByRef EnumOptionFile As EnumOptionFile = DirectoryWithFileName) As String On Error Resume Next Select Case EnumOptionFile Case DirectoryWithoutFileName GetFileOption = Left(strFilePath, InStrRev(strFilePath, "\")) Case DirectoryWithFileName GetFileOption = strFilePath Case FileNameWithExtension GetFileOption = Mid(strFilePath, InStrRev(strFilePath, "\") + 1) Case ExtensionOnly GetFileOption = Right(strFilePath, Len(strFilePath) - InStrRev(strFilePath, ".")) Case FileNameWithoutExtension GetFileOption = Mid(strFilePath, InStrRev(strFilePath, "\") + 1, InStrRev(strFilePath, ".") - InStrRev(strFilePath, "\") - 1) End Select On Error GoTo 0 End Function ' Function to get additional information about a file Function GetFileInfo(filePath As String) As String On Error Resume Next Dim fileInfo As String fileInfo = "File Information:" & vbCrLf fileInfo = fileInfo & "Path: " & filePath & vbCrLf fileInfo = fileInfo & "Size: " & FileLen(filePath) & " bytes" & vbCrLf fileInfo = fileInfo & "Created: " & FileDateTime(filePath) & vbCrLf GetFileInfo = fileInfo On Error GoTo 0 End Function 2- انشاء وحدة نمطية عامة ليسهل استخدامها فى شتى زوايا التطبيق واعطها الاسم التالى basExcelDataImport وضع بها هذا الكود Public Const strTableExcel As String = "tblImportExcel" Function ExcelDataImport(ByRef excelFilePath As String) On Error Resume Next ' Disable error handling temporarily Const xlOpenXMLWorkbook As Long = 51 ' Variables for Excel and Access Dim excelApp As Object Dim excelWorkbook As Object Dim excelOpened As Boolean Dim sourceFileName As String Dim mainDirectory As String Dim convertedExcelFilePath As String ' Check if the Excel file path is provided If Nz(excelFilePath, "") = "" Then Exit Function ' Check if the Excel file exists If Dir(excelFilePath) = "" Then Exit Function ' Extract file information sourceFileName = GetFileOption(excelFilePath, FileNameWithExtension) mainDirectory = GetFileOption(excelFilePath, DirectoryWithoutFileName) convertedExcelFilePath = excelFilePath ' Create Excel application object Set excelApp = CreateObject("Excel.Application") ' Check if Excel application is successfully created If Err.Number <> 0 Then Err.Clear Set excelApp = CreateObject("Excel.Application") excelOpened = False Else excelOpened = True End If ' Reset error handling On Error GoTo 0 ' Set Excel application visibility excelApp.Visible = False ' Open Excel workbook Set excelWorkbook = excelApp.Workbooks.Open(mainDirectory & sourceFileName) ' Save the workbook in xlsx format without displaying alerts excelApp.DisplayAlerts = False excelWorkbook.SaveAs Replace(mainDirectory & sourceFileName, ".xls", ".xlsx"), FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False excelApp.DisplayAlerts = True ' Close the workbook without saving changes excelWorkbook.Close False ' Quit Excel application if it was opened by the function If excelOpened = True Then excelApp.Quit ' Update the source file name with the new extension sourceFileName = sourceFileName & "x" ' Reset file attributes SetAttr mainDirectory & sourceFileName, vbNormal ' Import Excel data into Access table DoCmd.SetWarnings False 'acSpreadsheetTypeExcel8 DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, strTableExcel, mainDirectory & sourceFileName, True ExitFunction: ' Enable system alerts before exiting the function DoCmd.SetWarnings True Exit Function ErrorHandler: ' Handle errors Select Case Err.Number Case 3078: Resume Next ' Ignore error if user cancels the file dialog Case 0: Resume Next Case Else ' Call ErrorLog(Err.Number, Error$, strProcessName) End Select End Function ' Function to delete all records from the specified table Sub DeleteAllRecords(Optional ByRef strTable As String = "") On Error Resume Next If Nz(strTable, "") = "" Then strTable = strTableExcel CurrentDb.Execute "DELETE FROM " & strTable ' Handle errors Select Case Err.Number Case 3078 If strTable = strTableExcel Then Resume Next Else Case Else ' HandleAndLogError strProcessName End Select End Sub 3- انشاء نموذج وفى الحدث عند النقر على زر الامر استخدم الكود التالى Private Sub cmdSubmit_Click() ' Get the path of the Excel file Dim strFilePath As String strFilePath = GetFileDialog(EnumFileExtensions.ExcelFiles) ' Check if a file was selected If strFilePath <> "Cancelled" Then ' Show status label Me!lblStatus.Visible = True Me!lblStatus.Caption = "Please wait ... " ' Clear TableData DeleteAllRecords ' Import data from Excel ExcelDataImport strFilePath ' Add Or Update Yor Table ' Hide the status label or reset any visual indicator Me!lblStatus.Visible = False Else ' User canceled the file selection MsgBox "File selection canceled", vbExclamation End If End Sub كل ما عليك الان يا صديقى العزيز شئ واحد عمل الاستعلام اللازم لاضاقة او تحديث وتعديل بياناتك طبقا لجدول الاكس حسب رغباتك وتطلعاتك واخيرا مرفق قاعدة البيانات ImportFromExel.accdb

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

بعد اذن اخوانى الكرام واساتذتى العظماء اذا انا قدرت افهم اصح هذه تجربتى بالمرفق ده لو كنت فهمت صح يعنى ملحوظة انا حذفت جدول sub_tbl لان انا لا ارى له اى اثر ولا اى فائدة اصلا على الاقل طبقا للمرفق الاتى اختنا الغالية @safaa salem5 راجعت الاكواد قدر المستطاع وحسب ما ترائى لى قمت بسد كل الثغرات التى قد تضيف سجلات فارغة او ينتج عنها اخطاء باستخدام كود تصيد الاخطاء وذلك حسب الخطوات فقط التى كنت اقوم بتجربتها اذا فى المرفق الفائدة اولا من تحقيق طلبك برجاء مراجعة الاكواد قمت بالعديد من الاضافات والتغييرات كذلك باتت القاعدة لن تحفظ اى بيانات الا بالضغط على زر الامر حفظ lab8.zip

تم ايقاف دعم الاصدارات القديمة من مايكروسوفت طبعا انتقل لتواكب التطور تتنقل لاى اصدار انت قرر حسب متطلباتك وفقا للمقارنة الاتية... Microsoft Access Version Office 365 2021 2019 2016 2013 2010 2007 2003 2002 (XP) 2000 97 95 2.0 1.1 1.0 Original Release Date 2021 Oct 2021 Oct 2018 Sep 2015 Sep 2013 Feb 2010 Jul 2007 Jan 2003 Nov 2001 May 1999 Jun 1997 Jan 1995 Aug 1994 Apr 1993 May 1992 Nov Version Number 16.0 15.0 14.0 12.0 11.0 10.0 9.0 8.0 7.0 2.0 1.1 1.0 Latest Service Pack continuous -- -- -- SP1 SP2 SP3 SP3 SP3 SP3 SR2 -- 2.5 -- -- Minimum RAM 32 Bit: 2GB 64 Bit: 4GB 32 Bit: 1GB 64 Bit: 2GB 256 MB 256 MB 128 MB 72 MB 16 MB 16 MB 8 MB 4 MB -- -- Part of Microsoft Office Free Runtime Version Runtime Version Download Same as 365 Same as 365 Download Download Download Download Office Developer Edition 2003 Office Developer Edition 2002 Office Developer Edition 2000 Office Developer Edition 97 Access Developer's Toolkit 7.0 Access Developer's Toolkit 2.0 Access 1.1 Distribution Kit -- 64-bit Version Office 365 Installation Database Formats and Security Office 365 2021 2019 2016 2013 2010 2007 2003 2002 2000 97 95 2.0 1.1 1.0 Database Formats ACCDB & MDB ACCDB & MDB ACCDB & MDB ACCDB & MDB ACCDB & MDB ACCDB & MDB ACCDB & MDB MDB MDB MDB MDB MDB MDB MDB MDB MDB Format 2003 2003 2003 2003 2003 2003 2003 2003 2000 2000 97 2.0 2.0 1.1 1.0 Compiled MDE ACCDB Format Compiled ACCDE Jet Database Engine (DAO) ACE ACE ACE ACE ACE ACE ACE 4.0 4.0 4.0 3.5 3.0 2.0, 2.5 with SP 1.1 1.0 Access Database Engine (ACE) 16.0 Download 14.0 14.0 Download 12.0 Sandboxed ACE Workgroup Security (MDB format) ActiveX Data Objects (ADO) Record Locking, Unicode Storage Digital Signatures (MDB only) Does not support current code signing certificates Trusted Locations (Directories) Database Encryption (ACCDB) Data Macros (ACCDB) ODBC connection retry logic Access Data Projects (ADP) connected to SQL Server Access Web Apps (AWA) SharePoint 2013 SQL Server Office 365 SharePoint 2013 SQL Server SharePoint 2010 Lists Programming Office 365 2021 2019 2016 2013 2010 2007 2003 2002 2000 97 95 2.0 1.1 1.0 VBA Programming Language (VBA) Shared IDE with Visual Basic 6.0 Temporary Variables TempVars (ACCDB) Access Basic Programming Language Database Container Office 365 2021 2019 2016 2013 2010 2007 2003 2002 2000 97 95 2.0 1.1 1.0 Navigation Pane and Search Database Window Windows XP Themes Tabbed Interface Quick Access Toolbar Ribbons Change Office Theme Linked Tables Office 365 2021 2019 2016 2013 2010 2007 2003 2002 2000 97 95 2.0 1.1 1.0 Dataverse Enhanced Linked Table Manager Salesforce and Dynamics 365 365 Excel *.xlsx Format (ACCDB only) Saved Import/Export Specifications dBase Tables Lotus 1-2-3 Spreadsheets Paradox Tables Field Data Types Office 365 2021 2019 2016 2013 2010 2007 2003 2002 2000 97 95 2.0 1.1 1.0 Hyperlinks Link to SharePoint Lists Attachment Fields (ACCDB) Multi-value Fields (ACCDB) Memo Fields with History (ACCDB) Memo Fields as HTML (ACCDB) SQL Server BigInt 365 Date/Time Extended 365 Features Office 365 2021 2019 2016 2013 2010 2007 2003 2002 2000 97 95 2.0 1.1 1.0 ActiveX Controls Form Conditional Formatting of Fields Report Output to PDF Report View Alternating Row Colors Datasheet Totals Datasheet Multi-Select Column Filtering Simplified "Smart" Datasheet/Form Filtering Form Navigation Caption Form Buttons with Text and Image Form Object Anchoring and Resizing Date Picker Web Browser Control Image Control with Control Source Split Forms Navigation Forms Image Gallery (Shared Resources) Modern Charts Property Sheet sorting Enhanced Zoom Box 365 365 Add Tables Task Pane Highlighted Active Tab Dark Theme Support Query Designer, SQL and Relationship View Enhancements Command Bars Data Access Pages (DAP) Pivot Charts / Pivot Tables Smart Tags Visual SourceSafe Integration Upsizing Wizard Package Solution Wizard Data Collection Emails Microsoft References Office 365 2021 2019 2016 2013 2010 2007 2003 2002 (XP) 2000 97 95 2.0 1.1 1.0 New Features 2021 2019 2013 2010 Discontinued Features 2013 Windows Version Office 365 2021 2019 2016 2013 2010 2007 2003 2002 2000 97 95 2.0 1.1 1.0 Windows 11 * * * * Windows 10 * * * Windows 8.0/8.1 * * * Windows 7.0/SP1 * * Windows Vista SP1 * * Windows XP SP3 SP2 Windows 2000 SP3 Windows 98 Windows NT 4.0 SP6 SP2 SP2 Windows NT 3.51 SP5 Windows 95 Windows 3.1 Windows 3.0

ولا تزعلى نفسك سهله ان شاء الله اتفضلى يا افندم غيرى الكود السابق بالكود اللاحق Private Sub pname_AfterUpdate() If Not NewRecord Then Exit Sub Dim strDLookupFlds As String Dim stLinkCriteria As String Dim MyVariable As String Dim Arry() As String MyVariable = Me.pname stLinkCriteria = "[pname] ='" & MyVariable & "'" '|String On Error GoTo ErrorHandler strDLookupFlds = DLookup("[pname] & '|' & [code] & '|' & [ptitle] & '|' & [bdate] & '|' & [gender] & '|' & [phone] & '|' & [mobile] & '|' & [adress] & '|' & [email] & '|' & [wt] & '|' & [ht]", "[reservation_tbl]", stLinkCriteria) Arry = Split(strDLookupFlds, "|") Me.code = Arry(1) Me.ptitle = Arry(2) Me.bdate = Arry(3) Me.gender = Arry(4) Me.phone = Arry(5) Me.mobile = Arry(6) Me.adress = Arry(7) Me.email = Arry(8) Me.wt = Arry(9) Me.ht = Arry(10) ExitHandler: Exit Sub ErrorHandler: Select Case Err.Number Case Is = 94: pname.Requery: Resume ExitHandler Case Else MsgBox "Error Number : " & Err.Number & vbNewLine & "Error Description : " & Err.Description Resume ExitHandler End Select End Sub وغيرى الكود الخاص بزر امر الاضافة الى الكود الاتى Private Sub Add_cmd_Click() On Error GoTo Err_NewRec DoCmd.Requery DoCmd.GoToRecord , , acNewRec Exit_Err_NewRec: Exit Sub Err_NewRec: MsgBox Err.Description Resume Exit_Err_NewRec End Sub وهذا مرفقكم بعد التعديل lab3(2).zip

اكيد كود المريض الذي تريدين جلب بياناته غير موجود 🫣