نجوم المشاركات
Popular Content
Showing content with the highest reputation on 11/02/24 in مشاركات
-
اخونا العود ابوخليل ، في الواقع هذه تجربة سنين تم عصرها في مثل هذه المواضيع ، و دائما تكون انت الاصل 🙂 واخوتي الاعزاء عمر ضاحي ، و موسى ، و فادي ، و @co2002co ، اشكر لكم جميل كلماتكم 🙂4 points
-
السلام علبكم 🙂 بسبب اختلاف تنسيقات ملفات الاكسل (او CSV) ، وخصوصا تلك التي من مواقع وزارة التعليم في المملكة العربية السعودية ، كنا نضطر ان نتعامل بالكود مع كل تنسيق بطريقة تختلف عن الملف الآخر ، مما يجعل الحل لا يتناسب مع التنسيقات الملفات الاخرى ، وهذا الكود ليس بالسهل تعديله. ولكن ، تقريبا جميع مستخدمي الاكسس يعرفون التعامل مع الاستعلام ، لهذا السبب دعونا نتعامل مع بيانات الاكسل في استعلام ، استعلام مسقط 🙂 هذه واجهة النموذج الذي يتم كل شيء عن طريقه: 1. لتصفح الملفات ، واختيار ملف الاكسل (xls, xlsx, xlsm, csv) ، وسيظهر اسم الملف الذي تم اختيارة في الحقل رقم 2 ، 3. ستظهر قائمة بأسماء الاوراق (Sheets) الموجودة في الملف ، ويجب اختيار الورقة المطلوبة ، 4. هذا نموذج جدولي ، و ستظهر بيانات ورقة الاكسل هنا ، ويمكننا التعامل مع فرز وتصفية البيانات هنا ، وبعدة طرق ، 5. سيظهر استعلام مناداة ورقة الاكسل هنا (بدون فرز وتصفية) ، على شكل SQL ، وبأسماء حقول الورقة ، والتي يمكن نسخها لأي قاعدة بيانات خارجية ، 6. سيظهر استعلام مناداة ورقة الاكسل هنا (بدون فرز وتصفية) ، على شكل SQL ، وبدون أسماء حقول الورقة ، والتي يمكن نسخها لأي قاعدة بيانات خارجية ، 7. يجب النقر هنا حتى نرى نتائج الفرز والتصفية كجزء من الاستعلام في الحقول 8 و 9 ، 8. سيظهر استعلام مناداة ورقة الاكسل هنا (بالفرز والتصفية) ، على شكل SQL ، وبأسماء حقول الورقة ، والتي يمكن نسخها لأي قاعدة بيانات خارجية ، 9. سيظهر استعلام مناداة ورقة الاكسل هنا (بالفرز والتصفية) ، على شكل SQL ، وبأسماء حقول الورقة ، والتي يمكن نسخها لأي قاعدة بيانات خارجية ، 10. يمكنك عمل استعلام جاهز (للورقة بدون فرز وتصفية) او جدول ، سواء في قاعدة البيانات هذه ، او اختيار قاعدة بيانات خارجية (يجب ان تكون مغلقة حتى تستطيع تصدير استعلام او جدول لها) ، وسيكون اسم الاستعلام نفس اسم الورقة ، مثلا اسم الورقة ABC ، فيصبح اسم الاستعلام: qry_ABC ، او يكون جدول بإسم tbl_ABC حسب اختيارك من الرقم 11 ، او حتى الحاق بيانات الاستعلام الى جدول موجود سابقا (طبعا يجب مراعاة ان يكون الجدول بنفس حقول الورقة) ، 12. لنسخ الاستعلام الى ذاكرة الكمبيوتر ، بحيث يمكنك استعمال لصق ctrl+v لكائن الاستعلام (انظ الفيديو التوضيحي) ، 13. عادة لا نغير اي شيء هنا. طريقة العمل: . نرى من اعلاه: 1. انه تم عمل استعلام ياسم qry_Sheet1 في قاعدة البيانات الخارجة Testing.accdb ، 2. كذلك نسخنا استعلام التصفة الى ذاكرة الكمبيوتر (تابع في الفيديو التالي) . ممكن خلط عمل الفرز و التصفية بعدة طرق ، منها كما في الفيديو اعلاه ، و الصور التاليه . . لنفتح قاعدة البيانات الخارجية ونرى ما فيها ، هنا نحن نتعامل مع استعلام اكسس عادي ، فيمكننا حذف الحقول التي لا نريدها ، او نخفي اخرى ، او .... . عند فتح قاعدة البيانات الخارجية ، وحصلت على رسالة الخطأ هذه ، فهذا معناه ان برنامج "استعلام مسقط" لايزال مفتوح ، وملف الاكسل مفتوح به ، لذا يجب اغلاق برنامج "استعلام مسقط" قبل استعمال ملف الاكسل : . البرنامج يتعامل مع ملف واحد فقط ، ويعمل له استعلام ، واذا اردنا ان نتعامل مع اكثر من ورقة اكسل ، فيمكننا عمل مجموعة من استعلامات ، ثم نعمل امر لتنفيذها واحدة تلو الاخرى ، وبما انه عندنا استعلام ، فيمكننا تحويله الى جميع انواع الاستعلامات ، سواء استعلام الحاق ، او استعلام اضافة ، او استعلام لعمل جدول. هناك عدة ميزات في استعمال هذه الطريقة عن ربط الاكسل كجدول : 1. اسرع بكثير ، 2. عند استيراد كائنات قاعدة البيانات الى قاعدة اخرى ، فالاكسس يتوقف كثيرا عند الجداول الاكسل المرتبطة ، بينما لا يأخذ اي وقت لهذا الاستعلام 3. اختار الحقول اللي تريدها فقط ، جعفر Muscat_Query.zip3 points
-
يعني حصلتي على المطلوب .. ودعوتي له كان الأولى فتح موضوع جديد بمشكلتك الجديدة .. ولا بأس تشيري الى هذا الموضوع عن نفسي اتحاشى الرد على مواضيعك لهذا السبب .. خشية الا اجد الوقت في الاستمرار .. علما ان مثل هذا الاستمرار يعتبر مخالف لقواعد المشاركات لان الصحيح هو ان يكون كل عنوان وموضوع يناقش فكرة واحدة يتيمة فقط3 points
-
أختنا الكريمة صفاء ، أول حاجة محدش هنا ضدك أو ضد أي حد صدقيني ,, والأهم في الموضوع انك لاحظتي اختلاف وقلة الردود في مواضيعك بسبب اسلوبك اللي يخلي أي واحد بحاول يساعد ما يكررهاش تاني لأنه بيتوه في اللي انتي عايزاه . وفكرة انك قايلالي فدي بحد ذاتها مش صحيحة لأني في رسائل الخاص ما بينك وبيني انا لمحت لك وقلت لك بالإقتباس الجملة دي :- مش محتاج أزبط نفسي قدام أي حد من كلامي ده ، ولكن انتي عندك اسلوب تخلي اللي حواليكي ينفر من انه حتى يقرأ مشاركتك . والكلام ممكن مش بس يكون موجه ليكي تحديداً صدقيني . في ناس عددها قليل هنا عندها اسلوب تخليك تتجنب تشارك في مواضيعها . انا بعتذر من نفسي على الكلام ده لكن ، شكراً ليكي على انك فكرتيني باللي انتي قلتيه ( قصدي اللي انا قلته )2 points
-
تم إضافة نموذج لإنشاء العلاقات من خلال البرنامج بشكل بسيط بحيث :- يتم اختيار الجدول الأول ، ثم الحقل الذي نرغب بانشاء علاقة له ، ثم اختيار الجدول الثاني وكذلك الأمر اختيار الحقل الثاني الذي سيكون على علاقة مع الحقل السابق يتم التعرف على نوع بيانات الحقول التي تم اختيارها للتأكيد على انك كمستخدم تعرف أنواع البيانات في الحقلين . أيضاً يتم التعرف على الحقل ما إذا كان مقتاح أساسي أم لا . عند النقر على زر نوع العلاقة ، فسيتم اظهار نوع العلاقة المنطقية لهذين الحقلين . في الزر انشاء العلاقات سيتم انشاء العلاقة بشكل تلقائي بين الجدولين مع تفعيل تتالي الحذف والإضافة . لإختبار ما اذا كان هناك علاقة بين الجدولين ، من خلال الزر تحقق سيظهر لك نتيجة العلاقة إذا كانت موجودة ونوعها والحقول التي بينها علاقة في الجدولين . عند وجود علاقة سابقة بين الجدولين سيتم تنبيه المستخدم بوجود علاقة سابقة ، هل ترغب باستبدال العلاقة السابقة بعلاقة جديدة ؟؟ وفي حال الموافقة سيتم حذف العلاقة القديمة واستبدالها بالعلاقة الجديدة . طبعاً هنا يجب التنويه أن البرنامج لن يقوم بإنشاء أي علاقة غير صحيحة بين اي حقلين نهائياً . تم اضافة زر لحذف العلاقة بشكل اختياري بين اي جدولين بينهم علاقة . لإجراءاتكم بالتجربة وإفادتي بالنقاط التي قد أكون قد غفلت عنها . TBL Maker.accdb2 points
-
اخي الحبيب @moho58 حسب رسالتك معي على الخاص فان المشكله معاك تحدث عندما تحاول ادراج ملف بعد ان تكتب السنه او اى شئ وهذا يحدث بسبب الاتي وانك عندما تبدأ فى تسجيل مثلا السنه فانك بالفعل مازلت فى وضع السجل الجديد وبالتالى لما تضغط على الزر لتحديد الملف فانك بالفعل ايضا فى وضع السجل الجديد ومفيش معرف تم حفظه جديد علشان يتم الربط به وبالتالى الحل ان تسجل السنه واي شئ اخر انت تريده وتنتقل لاى سجل اخر علشان يتم الحفظ ثم بعدها ترفق الملف ام ممكن تجرب فى حدث بعد التحديث ان تجعل النموذج يعمل Requery مثل هذا الكود Private Sub annee_dossier_AfterUpdate() Form.Requery End Sub Private Sub titre_f_AfterUpdate() Form.Requery End Sub وبكده مشكلتك هتتحل ان شاء الله اتمني ان اكون قدرت اوصل لك المعلومه بشكل صحيح2 points
-
2 points
-
الاداة مفتوحة المصدر 😎 يمكنك التعديل وتقديم الحلول والاقتراحات ================================================== فقط اختر ملف اكسل وحدد اسم ورقة العمل + رقم ورقة العمل شاهدوا الفيديو للتوضيح تحميل نسخة الاداة https://www.mediafire.com/file/rpd89qapnkgs0gm/Link_File_excil_With_editor_Ms_Access.rar/file1 point
-
السلام عليكم ورحمة الله وبركاته الأخوة الكرام تحية طيبة وبعد ،،، تقوم الفكرة علي ضبط وقت محدد للرسائل وإتاحة فرصة للمستخدم لإتخاذ القرار وعند إنتهاء المدة المحددة يتم إعتماد الزر الإفتراضي الوظيفة : tempMsgBox فقط نزيد temp علي الـ MsgBox العادية وتستخدم نفس الإستخدام ونضيف فقط المدة لمحددة (الوقت الإفتراضي هو 5 ثواني) الكود كامل بالأمثلة Option Compare Database Option Explicit '---------------------------------------------------------------------------------------------------------- ' Module : AWS_Temp_MessageBox ' Author : Original: Collected over the internet I don't remember ' Enhanced: Ahmos - The Last Egyptian King ' Email : Phoronex@yahoo.com ' Purpose : Provides customizable message boxes with automatic timeout and default actions ' Copyright : © 2024 Ahmos. Released under Attribution 4.0 International ' (CC BY 4.0) - https://creativecommons.org/licenses/by/4.0/ ' ' Usage: ' ~~~~~~ ' result = tempMsgBox("Message", vbOKOnly) ' Basic message box ' result = tempMsgBox("Message", vbYesNo, "Title", 5000) ' Custom timeout message box ' result = tempMsgBox("Continue?", vbYesNo + vbDefaultButton2) ' Default No after timeout ' ' Revision History: ' Rev Date(yyyy-mm-dd) Description '---------------------------------------------------------------------------------------------------------- ' 1 Unknown Initial version with basic MessageBoxTimeoutA API ' 2 2024-11-01 Enhanced version: ' - Added input validation ' - Enhanced error handling ' - Added timeout management ' - Added default action handling ' - Added comprehensive documentation ' 3 2024-11-02 Remapping the default button style based on the number of buttons ' - All Credits TO ( https://claude.ai) '---------------------------------------------------------------------------------------------------------- ' Functions: ' ~~~~~~~~~~ ' tempMsgBox : Main function for displaying timeout message boxes ' GetDefaultButtonStyle : Helper function for determining default buttons ' ValidateTimeout : Validates timeout parameters ' ValidateButtons : Validates button combinations ' ' Dependencies: ' ~~~~~~~~~~~~ ' - Windows API (user32.dll) ' - VBA7 for 64-bit support ' ' Notes: ' ~~~~~~ ' - Supports all standard VBA message box button combinations ' - Automatic timeout with configurable duration ' - Default action handling on timeout ' - 32/64-bit compatible using conditional compilation ' - Enhanced error handling with custom error codes '---------------------------------------------------------------------------------------------------------- ' **-----**_______________{]___________________________________________________________ ' {&&&&&&&#%%&#%&%&%&%&%#%&|]__________________________The Last Egyptian King___________\ ' {] '---------------------------------------------------------------------------------------------------------- ' Constants Private Const DEFAULT_TIMEOUT_MILLISECONDS As Long = 5000 Private Const MINIMUM_TIMEOUT_MILLISECONDS As Long = 1000 Private Const MAXIMUM_TIMEOUT_MILLISECONDS As Long = 300000 ' 5 minutes #If VBA7 Then Private Declare PtrSafe Function MessageBoxTimeoutA Lib "user32" ( _ ByVal hwnd As LongPtr, _ ByVal lpText As String, _ ByVal lpCaption As String, _ ByVal wType As VbMsgBoxStyle, _ ByVal wlange As Long, _ ByVal dwTimeout As Long _ ) As Long #Else Private Declare Function MessageBoxTimeoutA Lib "user32" ( _ ByVal hwnd As Long, _ ByVal lpText As String, _ ByVal lpCaption As String, _ ByVal wType As VbMsgBoxStyle, _ ByVal wlange As Long, _ ByVal dwTimeout As Long _ ) As Long #End If '/// Custom Error Constants Private Const ERROR_INVALID_TIMEOUT As Long = vbObjectError + 1000 Private Const ERROR_INVALID_BUTTONS As Long = vbObjectError + 1001 '/// Enumerations Public Enum TempMsgBoxTimeoutResult VbTimeout = 32000 End Enum '/// Function: ValidateTimeout '/// Validates the timeout value is within acceptable range '/// @param timeoutMs - Timeout value in milliseconds '/// @returns Boolean - True if valid, False if invalid Private Function ValidateTimeout(ByVal timeoutMs As Long) As Boolean ValidateTimeout = (timeoutMs >= MINIMUM_TIMEOUT_MILLISECONDS And timeoutMs <= MAXIMUM_TIMEOUT_MILLISECONDS) End Function '/// Function: ValidateButtons '/// Validates the message box buttons combination '/// @param buttons - VbMsgBoxStyle value for buttons '/// @returns Boolean - True if valid, False if invalid Private Function ValidateButtons(ByVal buttons As VbMsgBoxStyle) As Boolean Dim validButtonCombos As Variant validButtonCombos = Array(vbOKOnly, vbOKCancel, vbYesNo, vbYesNoCancel, vbRetryCancel, vbAbortRetryIgnore) Dim baseButtons As VbMsgBoxStyle baseButtons = buttons And 7 ' Get only the buttons part Dim i As Long For i = LBound(validButtonCombos) To UBound(validButtonCombos) If baseButtons = validButtonCombos(i) Then ValidateButtons = True Exit Function End If Next i ValidateButtons = False End Function '/// Function: msgBtnRemapping '/// Remapping the default button style based on the number of buttons '/// @param msgButtons - Button combination (e.g., vbYesNo, vbAbortRetryIgnore) '/// @param defaultButton - The requested default button style '/// @returns VbMsgBoxStyle - The normalized default button style Private Function msgBtnRemapping(ByVal msgButtons As VbMsgBoxStyle, ByVal defaultButton As VbMsgBoxStyle) As VbMsgBoxStyle ' Get only the basic button combination (strip other flags) Dim baseButtons As VbMsgBoxStyle baseButtons = msgButtons And 7 ' For two-button combinations If baseButtons = vbYesNo Or baseButtons = vbRetryCancel Or baseButtons = vbOKCancel Then Select Case defaultButton And &HF00 ' Mask to get only default button bits Case vbDefaultButton3 ' Equivalent to Button1 msgBtnRemapping = (msgButtons And Not &HF00) Or vbDefaultButton1 ' Debug.Print "Two buttons: Changed DB3 to DB1" Case vbDefaultButton4 ' Equivalent to Button2 msgBtnRemapping = (msgButtons And Not &HF00) Or vbDefaultButton2 ' Debug.Print "Two buttons: Changed DB4 to DB2" Case Else msgBtnRemapping = msgButtons ' Debug.Print "Two buttons: No change needed" End Select ' For three-button combinations ElseIf baseButtons = vbAbortRetryIgnore Or baseButtons = vbYesNoCancel Then Select Case defaultButton And &HF00 ' Mask to get only default button bits Case vbDefaultButton4 ' Equivalent to Button2 msgBtnRemapping = (msgButtons And Not &HF00) Or vbDefaultButton2 ' Debug.Print "Three buttons: Changed DB4 to DB2" Case Else msgBtnRemapping = msgButtons ' Debug.Print "Three buttons: No change needed" End Select ' For single-button combinations (vbOKOnly) Else msgBtnRemapping = (msgButtons And Not &HF00) Or vbDefaultButton1 ' Debug.Print "Single button: Set to DB1" End If End Function '/// Function: GetDefaultButtonStyle '/// Determines and validates the default button style '/// @param msgButtons - VbMsgBoxStyle value for buttons '/// @returns VbMsgBoxStyle - The normalized button style Private Function GetDefaultButtonStyle(ByVal msgButtons As VbMsgBoxStyle) As VbMsgBoxStyle ' Debug.Print "Original buttons: " & msgButtons ' Apply Button Remapping Dim reMappedButtons As VbMsgBoxStyle reMappedButtons = msgBtnRemapping(msgButtons, msgButtons) ' Debug.Print "ReMapped buttons: " & reMappedButtons GetDefaultButtonStyle = reMappedButtons End Function '/// Function: GetTimeoutDefaultValue '/// Determines the default value to return when timeout occurs '/// @param msgButtons - Button style of the message box '/// @param defaultButtonStyle - Default button style '/// @returns VbMsgBoxResult - The default value to return Private Function GetTimeoutDefaultValue(ByVal msgButtons As VbMsgBoxStyle, ByVal defaultButtonStyle As VbMsgBoxStyle) As VbMsgBoxResult ' Get only buttons information msgButtons = msgButtons And 7 Select Case msgButtons Case vbYesNo Select Case defaultButtonStyle Case vbDefaultButton1: GetTimeoutDefaultValue = vbYes Case vbDefaultButton2: GetTimeoutDefaultValue = vbNo Case vbDefaultButton3: GetTimeoutDefaultValue = vbYes Case vbDefaultButton4: GetTimeoutDefaultValue = vbNo Case Else: GetTimeoutDefaultValue = vbYes End Select Case vbYesNoCancel Select Case defaultButtonStyle Case vbDefaultButton1: GetTimeoutDefaultValue = vbYes Case vbDefaultButton2: GetTimeoutDefaultValue = vbNo Case vbDefaultButton3: GetTimeoutDefaultValue = vbCancel Case vbDefaultButton4: GetTimeoutDefaultValue = vbNo Case Else: GetTimeoutDefaultValue = vbYes End Select Case vbAbortRetryIgnore Select Case defaultButtonStyle Case vbDefaultButton1: GetTimeoutDefaultValue = vbAbort Case vbDefaultButton2: GetTimeoutDefaultValue = vbRetry Case vbDefaultButton3: GetTimeoutDefaultValue = vbIgnore Case vbDefaultButton4: GetTimeoutDefaultValue = vbRetry Case Else: GetTimeoutDefaultValue = vbAbort End Select Case vbRetryCancel Select Case defaultButtonStyle Case vbDefaultButton1: GetTimeoutDefaultValue = vbRetry Case vbDefaultButton2: GetTimeoutDefaultValue = vbCancel Case vbDefaultButton3: GetTimeoutDefaultValue = vbRetry Case vbDefaultButton4: GetTimeoutDefaultValue = vbCancel Case Else: GetTimeoutDefaultValue = vbRetry End Select Case vbOKCancel Select Case defaultButtonStyle Case vbDefaultButton1: GetTimeoutDefaultValue = vbOK Case vbDefaultButton2: GetTimeoutDefaultValue = vbCancel Case vbDefaultButton3: GetTimeoutDefaultValue = vbOK Case vbDefaultButton4: GetTimeoutDefaultValue = vbCancel Case Else: GetTimeoutDefaultValue = vbOK End Select Case vbOKOnly GetTimeoutDefaultValue = vbOK Case Else GetTimeoutDefaultValue = TempMsgBoxTimeoutResult.VbTimeout End Select End Function '/// Function: tempMsgBox '/// Displays a message box that automatically closes after a specified timeout '/// @param msgText - The message to display '/// @param msgButtons - Button combination to display (optional) '/// @param msgTitle - Title of the message box (optional) '/// @param msgTimeoutMilliseconds - Timeout in milliseconds (optional) '/// @returns VbMsgBoxResult - The result of the message box Public Function tempMsgBox( _ ByVal msgText As String, _ Optional ByVal msgButtons As VbMsgBoxStyle = vbOKOnly, _ Optional ByVal msgTitle As String = vbNullString, _ Optional ByVal msgTimeoutMilliseconds As Long = DEFAULT_TIMEOUT_MILLISECONDS) As VbMsgBoxResult On Error GoTo ErrorHandler ' Debug.Print String(50, "-") ' Debug.Print "tempMsgBox called with buttons: " & msgButtons ' Input validation If Not ValidateTimeout(msgTimeoutMilliseconds) Then Err.Raise ERROR_INVALID_TIMEOUT, "tempMsgBox", _ "Timeout must be between " & MINIMUM_TIMEOUT_MILLISECONDS & _ " and " & MAXIMUM_TIMEOUT_MILLISECONDS & " milliseconds" End If If Not ValidateButtons(msgButtons) Then Err.Raise ERROR_INVALID_BUTTONS, "tempMsgBox", _ "Invalid button combination specified" End If ' Get normalized button style Dim finalMsgButtons As VbMsgBoxStyle finalMsgButtons = GetDefaultButtonStyle(msgButtons) ' Debug.Print "Final buttons before API call: " & finalMsgButtons ' Call the MessageBoxTimeoutA API function tempMsgBox = MessageBoxTimeoutA(Application.hWndAccessApp, _ msgText, _ msgTitle, _ finalMsgButtons, _ 0, _ msgTimeoutMilliseconds) ' Debug.Print "API returned: " & tempMsgBox ' Handle timeout case If tempMsgBox = TempMsgBoxTimeoutResult.VbTimeout Then tempMsgBox = GetTimeoutDefaultValue(msgButtons, (finalMsgButtons And &HF00)) ' Debug.Print "Timeout occurred, using default value: " & tempMsgBox End If Exit Function ErrorHandler: Debug.Print "Error occurred: " & Err.Number & " - " & Err.Description Select Case Err.Number Case ERROR_INVALID_TIMEOUT, ERROR_INVALID_BUTTONS MsgBox "Configuration Error: " & Err.Description, _ vbCritical, _ "tempMsgBox Error" Case Else MsgBox "An unexpected error occurred: " & vbNewLine & _ "Error " & Err.Number & ": " & Err.Description, _ vbCritical, _ "tempMsgBox Error" End Select tempMsgBox = vbCancel End Function Public Sub printUserChoice(lResult As Long) Select Case lResult Case vbAbort Debug.Print "User clicked Abort", lResult Case vbRetry Debug.Print "User clicked Retry", lResult Case vbIgnore Debug.Print "User clicked Ignore", lResult Case vbYes Debug.Print "User clicked Yes", lResult Case vbNo Debug.Print "User clicked No", lResult Case vbOK Debug.Print "User clicked OK", lResult Case vbCancel Debug.Print "User clicked Cancel", lResult Case Else Debug.Print "Unknown result", lResult End Select End Sub '/// Sub: TestTempMsgBox '/// Test procedure demonstrating various uses of the tempMsgBox function Public Sub TestTempMsgBox() Dim result As VbMsgBoxResult Dim msgTitle As String msgTitle = "Test Message" ' Test 1: Basic message with timeout result = tempMsgBox("This message will timeout in 3 seconds", _ vbInformation + vbOKOnly, _ msgTitle, _ 3000) Debug.Print "Test 1 Result: " & result ' Test 2: Yes/No dialog with default No result = tempMsgBox("Would you like to continue?", _ vbQuestion + vbYesNo + vbDefaultButton2, _ msgTitle, _ 5000) Debug.Print "Test 2 Result: " & result If result = vbYes Then Debug.Print "Action If YES" ElseIf result = vbNo Then Debug.Print "Action If NO" End If ' Test 3: Yes/No/Cancel dialog with default Cancel result = tempMsgBox("Confirm action", _ vbQuestion + vbYesNoCancel + vbDefaultButton3, _ msgTitle, _ 4000) Debug.Print "Test 3 Result: " & result ' Test 4: Abort/Retry/Ignore with default Ignore result = tempMsgBox("An error occurred. Retry or Ignore?", _ vbExclamation + vbAbortRetryIgnore + vbDefaultButton3, _ msgTitle, _ 1000) printUserChoice result End Sub Sub Test_allCases() Dim result As VbMsgBoxResult Dim msgTitle As String Dim msTime As Long msgTitle = "Test Message" msTime = 1000 Debug.Print "vbAbortRetryIgnore All Buttons Test Cases" result = tempMsgBox("An error occurred. Retry or Ignore?", _ vbExclamation + vbAbortRetryIgnore + vbDefaultButton1, _ msgTitle, _ msTime) Debug.Print "vbDefaultButton1" printUserChoice result result = tempMsgBox("An error occurred. Retry or Ignore?", _ vbExclamation + vbAbortRetryIgnore + vbDefaultButton2, _ msgTitle, _ msTime) Debug.Print "vbDefaultButton2" printUserChoice result result = tempMsgBox("An error occurred. Retry or Ignore?", _ vbExclamation + vbAbortRetryIgnore + vbDefaultButton3, _ msgTitle, _ msTime) Debug.Print "vbDefaultButton3" printUserChoice result result = tempMsgBox("An error occurred. Retry or Ignore?", _ vbExclamation + vbAbortRetryIgnore + vbDefaultButton4, _ msgTitle, _ msTime) Debug.Print "vbDefaultButton4" printUserChoice result Debug.Print String(50, "-") End Sub Public Sub Test_msgBtnRemapping() Debug.Print "Testing two-button combinations..." ' Test Yes/No with different default buttons Debug.Print "Testing Yes/No" Dim result As VbMsgBoxResult result = tempMsgBox("Test YesNo DB3", vbYesNo + vbDefaultButton3, "Test", 5000) printUserChoice result result = tempMsgBox("Test YesNo DB4", vbYesNo + vbDefaultButton4, "Test", 5000) printUserChoice result Debug.Print "Testing three-button combinations..." ' Test AbortRetryIgnore with different default buttons Debug.Print "Testing AbortRetryIgnore" result = tempMsgBox("Test ARI DB4", vbAbortRetryIgnore + vbDefaultButton4, "Test", 5000) printUserChoice result End Sub1 point
-
جزاك الله خير اخوي جعفر عندي في مكتبتي امثلة كثيرة جدا لطرق الاستيراد والتصدير من والى اكسل ، وعندما احتاج عمل شيء ما .. لا اخرج بفائدة او نتيجة من هذا الكم المحفوظ ، واضطر في النهاية الى الاجتهاد وعمل اللازم من الصفر تقريبا .. ويبدو ان في هذا الموضوع الحل الشافي على طاري مسقط .. عمرها الله بالايمان ورزق اهلها الخير والأمان وسائر بلدان المسلمين لك موضوع بعنوان : مسقط التقارير .. ويتبادر الى الذهن الاسقاط وهنا الاسم صريح .. ويكفي ادخال السرور الى قلب اخينا موسى اكرر شكري ودعائي لك بالتوفيق ،،،1 point
-
1 point
-
اكيد مرتبط بملفات DATA LINK الجل السريع نسخ بيانات الشيت فى ملف جديد ولصق (TEXT VALUE)1 point
-
شكرا اخوي موسى 🙂 لاحظ انه توجد بعض الحقول فيها قيمة سابقة ، فهذا معناه ان الكود شغال ، اذن فيه شيء يخلي قيم بعض الحقول ما تطلع ، شوف في اعداداتها1 point
-
وعليكم السلام ورحمة الله تعالى وبركاته 1) بما أن الملف لا يتضمن معادلات حاول تجربة تقليل حجم الملف عبر إزالة الصفوف أو الأعمدة الفارغة وأي بيانات غير ضرورية مع التأكد من عدم وجود تنسيقات زائدة (مثل الألوان أو أنماط الخلايا) الغير مستخدمة فهي تؤثر على سرعة التحميل 2) في حالة وجود كود VBA مثلا في حدث ورقة الإدخال يمكن أن يكون سببا في عملية البطئ التي تواجهك خاصة إذا كان الكود يقوم بعمليات معقدة أو يتضمن حلقات 3) قم بحفظ الملف بصيغة xlsb حيث إن هذه الصيغة عادة ما تكون أخف بالتوفيق.......1 point
-
عفوا سيدى الفاضل الخطأ من عندى حيث يوجد خطأ بكلمة الرئيسية جزاكم الله خيرا وبارك فيكم1 point
-
بسم الله ما شاء الله ,, اللي عجبني في الفكرة انه ورقة اكسيل في اكسيس زي ما هي في الملف . أبداع ما بعده ابداع معلمنا الفاضل وأستاذنا الكبير قبل القهوة والتحلاية يبغالها منسف علشان تعرف تركز أستاذ موسى1 point
-
1 point
-
استاذى الفاضل محمد هشام هذا ما اقصد وابغى واريد ... ما شاء الله اعتقد ان هذا الفورم به كل ما يحتاجه اى شخص يتعامل مع الفورم وللامانة معظم ما يتطلبه للتعامل مع الفورم زادكم الله من فضله وكرمه وجعله فى ميزان حسناتك .. لا اجد كلمات تعبير عن مشاعرى واعجابى باخلاصكم وتعاونكم معنا خير من الدعاء فاللهم تقبل يا رب العالمين1 point
-
1 point
-
تحية عاطرة لك حبيبنا مستر @Foksh 🙂🌹 جمال على جمال .. وإبداع يلحقه إبداع 😊👌 :: لعيونك تم دمج التحديث بالمشاركة الأولى ::1 point
-
للأسف يا مهندسنا الغالي ، هي عندها برنامج وعلى ما يبدو إنه غير مجاني أو أنها لا تملك صلاحيات كاملة فيه أو أي سبب آخر ؛ وعايزة تعمل برنامج يشبهه بالضبط . والدليل في عبارتها في نفس المنتدى الذي أشرت إليه .. لا تعليق1 point
-
1 point
-
1 point
-
السلام عليكم اخي الكريم بعد اضافة خاصية requery والتجربة باضافة ملفات كثيرة حمد لله يشتغل الكود بامتياز وبدون مشاكل فجزاء الله اخي الكريم خير الجزاء وجعله في ميزان حسناتك وشكرا كثيرا كثيرا على الصبر و المتابعة معي1 point
-
Option Explicit Sub test() Dim arr As Variant, i As Long, Irow As Long Dim dictA As Object, dictB As Object, dictC As Object, dictD As Object Dim n As Variant, a As Variant, b As Variant, c As Variant Dim WS As Worksheet: Set WS = Sheets("Sheet1") With WS Irow = .Columns("A:E").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row If WorksheetFunction.CountA(.Range("A2:A" & Irow)) = 0 And _ WorksheetFunction.CountA(.Range("B2:B" & Irow)) = 0 Then MsgBox "لا توجد بيانات للمقارنة", vbExclamation Exit Sub End If 'Code ............. .................. Set dictC = CreateObject("Scripting.Dictionary") Set dictD = CreateObject("Scripting.Dictionary") For i = 2 To Irow If WS.Cells(i, 3).Value <> "" Then dictC(WS.Cells(i, 3).Value) = True If WS.Cells(i, 4).Value <> "" Then dictD(WS.Cells(i, 4).Value) = True Next i For i = 2 To Irow If WS.Cells(i, 1).Value <> "" Then If dictC.exists(WS.Cells(i, 1).Value) Or dictD.exists(WS.Cells(i, 1).Value) Then WS.Cells(i, 1).Interior.Color = RGB(255, 255, 0) End If End If If WS.Cells(i, 2).Value <> "" Then If dictC.exists(WS.Cells(i, 2).Value) Or dictD.exists(WS.Cells(i, 2).Value) Then WS.Cells(i, 2).Interior.Color = RGB(255, 165, 0) End If End If Next i Application.ScreenUpdating = True End Sub مقارنة 3.xlsb1 point
-
وعليكم السلام ورحمة الله وبركاته =CEILING(G14*E14; 1) بالتوفيق1 point
-
وعليكم السلام ورحمة الله وبركاته تم عمل كود بدل معادلات الصفيف والترتيب الكود ينظر الى السنة اولا بمبن العلامة المائلة ثم يبحث عن اصغر رقم يسارا تم عمل قائمة اختيار لاختيار N° Bordereau وكلما اضفت رقما اضيف الى القائمة لك كل الاحترام والتقدير BORDEREAU FACILE1.xlsm1 point
-
السلام عليكم اخوي ابوخليل 🙂 . هنا افرز خلاصة تجاربي مع مؤسسات متشعبة الاعمال 🙂 والحمدلله انه اوجد لنا هذا السماء الفسيح لنشر المعرفة ، فشكرا لك دكتور @محمد طاهر عرفه 🙂 جعفر1 point
-
السلام عليكم 🙂 عملت قاعدة بيانات وبها نموذج لعمل جميع الاكواد برمجيا1 point