ابو جودي

ههههههه انا جاوبت فى سرى ينفع لا بلاش هزار لحسن حد يزعق لى انا بالفعل حضرتت الاجابة وفى آخر لحظة تراجعت عن عمل المشاركة ورفع المرفق السبب: بكل صراحة لم أكن راضيا عنها جارى العمل على تعديل اكواد لتكون الإجابة شاملة و كافية و وافيه بقدر الإمكان للإقتراب قدر الإمكان من أقرب درجات الكمال لأكون راض عن المشاركة

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

هلا والله.. والله اشتقنا يا اهلا بمفاجئاتك انت لازم تطلع عنيننا يا استاذنا الغالى انا قلت كتبت الكود على حسب المشكلات اللى واجهتنى وفتها بس ولا يهمك انت تأمر من عيونى بس استبدل الدالة التالية Private Sub AnalyzeDateParts(strPartOne As String, strPartTwo As String, strPartThree As String, _ ByRef intDay As Integer, ByRef intMonth As Integer, ByRef intYear As Integer) ' This subroutine analyzes the lengths of the date parts to determine their roles as day, month, or year. ' Depending on the format of the input string, it assigns the appropriate values to intYear, intMonth, and intDay. If Len(strPartOne) = 4 Then ' Year is first (Format: YYYY-MM-DD or YYYY-DD-MM) intYear = CInt(strPartOne) If CInt(strPartTwo) > 12 Then ' Format: YYYY-DD-MM intDay = CInt(strPartTwo) intMonth = CInt(strPartThree) Else ' Format: YYYY-MM-DD intMonth = CInt(strPartTwo) intDay = CInt(strPartThree) End If ElseIf Len(strPartThree) = 4 Then ' Year is last (Format: DD-MM-YYYY) intYear = CInt(strPartThree) intMonth = CInt(strPartTwo) intDay = CInt(strPartOne) ElseIf Len(strPartTwo) = 4 Then ' Year is in the middle (Format: DD-YYYY-MM or MM-YYYY-DD) intYear = CInt(strPartTwo) If CInt(strPartOne) > 12 Then intDay = CInt(strPartOne) intMonth = CInt(strPartThree) ElseIf CInt(strPartThree) > 12 Then intDay = CInt(strPartThree) intMonth = CInt(strPartOne) Else intDay = CInt(strPartOne) intMonth = CInt(strPartThree) End If Else ' All parts are small numbers (Format: D-M-YY) intDay = CInt(strPartOne) intMonth = CInt(strPartTwo) intYear = CInt(strPartThree) ' Confirm year is in the correct range ' If the year is provided as a two-digit number, it will be treated as a year in the 2000s. If intYear < 100 Then intYear = intYear + 2000 End If End If End Sub واستبدل السطر الخاص بالمصفوفة المصفوفة القديمة بالمصفوفة الاتية SymbolsToRemove = Array("(", ")", "?", "*", " ", "!", "-", "#", "@", "+", "\", "/", "//", ".", "_", "--", "|", ",", Chr(227), Chr(34)) المرفق بعد التعديلات RectifyDate (V 2).accdb

بعد اذن استاذى الجليل و معلمى القدير و والدى الحبيب الاستاذ @jjafferr فعلا الموضوع مهم وملح جدا جدا لمن يقع فى هذه الورطة خاصة مع كثرة عدد السجلات التى تحتوى على صيغ تواريخ مختلفة وبالاخص لو كانت بها مشاكل اثراء للموضوع صادفنى هذه المشكلة ذات مرة فى العمل وهذه هى الوظيفة التى قمت بكتابتها للتعامل مع مختلف الصيغ والتسيقات حسب المشاكل التى واجهتها آن ذاك Function RectifyDateFormat(inputString As String) As Variant ' Enable error handling ' This line sets up an error handling routine. If an error occurs in the code that follows, ' execution will jump to the ErrorHandler label, allowing for controlled error management. On Error GoTo ErrorHandler ' Remove leading and trailing spaces ' This line uses the Trim function to eliminate any spaces at the beginning and end of the input string. ' This is important for ensuring that the date format is clean and free of unnecessary spaces ' which could lead to incorrect parsing of date parts later in the function. inputString = Trim(inputString) ' Replace Indian numerals with standard numerals ' This block replaces Indian numerals (Unicode character codes from 1632 to 1641) with standard Arabic numerals (0-9). ' The loop iterates through the Unicode range for Indian numerals and replaces each occurrence ' in the input string with its equivalent standard numeral by calculating its index. Dim i As Integer For i = 1632 To 1641 inputString = Replace(inputString, ChrW(i), CStr(i - 1632)) Next i ' Replace non-standard symbols with hyphens ' This section defines an array of symbols that are considered non-standard for date formatting. ' The goal is to standardize the date input by replacing these symbols with hyphens, ' making it easier to parse the date parts later on. Dim SymbolsToRemove As Variant SymbolsToRemove = Array("(", ")", "?", "*", " ", "!", "\", "/", "//", ".", "_", "--", "|", ",", Chr(227), Chr(34)) inputString = ReplaceSymbols(inputString, SymbolsToRemove) ' Remove leading and trailing hyphens ' This line first replaces any occurrence of double hyphens (--) with a single hyphen (-). ' After replacing, Trim is used to remove any spaces around the string. ' This ensures that any malformed input resulting in multiple hyphens is corrected before further processing. inputString = CleanHyphens(inputString) ' Split the input string into date parts ' This line splits the cleaned input string into an array of date parts using the hyphen (-) as a delimiter. ' The result is stored in strDateParts, which will contain the individual components of the date (day, month, year). Dim strDateParts() As String strDateParts = Split(inputString, "-") ' Ensure the input contains exactly three parts ' This condition checks if the upper bound of the strDateParts array is not equal to 2. ' In VBA, the array index starts from 0, so an array with exactly three elements will have ' an upper bound of 2 (i.e., elements at index 0, 1, and 2). ' If the input does not contain exactly three parts, the function returns Null ' to indicate an invalid date format, and exits the function to prevent further processing. If UBound(strDateParts) <> 2 Then RectifyDateFormat = Null Exit Function End If ' Assign the split parts to variables, ensuring they are trimmed ' This line assigns the individual parts of the date from the strDateParts array ' to three separate variables (strPartOne, strPartTwo, strPartThree). ' The Trim function is used to remove any leading or trailing whitespace from each part. ' This ensures that any extra spaces do not affect the subsequent processing of date parts. Dim strPartOne As String, strPartTwo As String, strPartThree As String strPartOne = Trim(strDateParts(0)): strPartTwo = Trim(strDateParts(1)): strPartThree = Trim(strDateParts(2)) ' Debug output for each part ' This line outputs the individual parts of the date to the immediate window for debugging purposes. ' Debug.Print "Part One: " & strPartOne & " | Part Two: " & strPartTwo & " | Part Three: " & strPartThree ' Ensure that the parts can be converted to numbers ' This conditional statement checks if each of the date parts (strPartOne, strPartTwo, strPartThree) ' can be converted to a numeric value. It uses the IsNumeric function to evaluate whether ' each part is a valid number. If any of the parts cannot be converted to a number, it indicates ' an invalid date format. In this case, the function returns Null to signify that the input is not a valid date, ' and exits the function to prevent further processing. If Not IsNumeric(strPartOne) Or Not IsNumeric(strPartTwo) Or Not IsNumeric(strPartThree) Then RectifyDateFormat = Null Exit Function End If ' Declare integer variables for the day, month, and year ' These declarations create integer variables to hold the day, month, and year components of the date. ' These will be used for further processing and validation of the date before returning the formatted result. Dim intDay As Integer, intMonth As Integer, intYear As Integer ' Analyze the parts to determine their roles ' This block of code evaluates the lengths of the date parts to determine their roles as day, month, or year. ' Depending on the format of the input string, it assigns the appropriate values to intYear, intMonth, and intDay. AnalyzeDateParts strPartOne, strPartTwo, strPartThree, intDay, intMonth, intYear ' Validate the final values ' This conditional checks if the final values for day, month, and year are valid. ' If any value is outside the expected range, the function returns Null to indicate an invalid date. If Not IsValidDate(intDay, intMonth, intYear) Then RectifyDateFormat = Null Exit Function End If ' Create the date and format it ' This line creates a date using the DateSerial function, which takes year, month, and day as parameters. ' The resulting date is then formatted as a string in the "dd/mm/yyyy" format. ' The formatted date string is assigned to the function's return value, RectifyDateFormat. RectifyDateFormat = Format(DateSerial(intYear, intMonth, intDay), "dd/mm/yyyy") Exit Function ' This line exits the function normally. ' If no errors occur, the code will not reach the ErrorHandler section. ErrorHandler: ' Handle errors gracefully ' If an error occurs in the preceding code, this line sets the return value of the function to Null, ' indicating that the date format correction failed due to an error. RectifyDateFormat = Null End Function Private Function ReplaceSymbols(inputString As String, SymbolsToRemove As Variant) As String ' This function iterates through an array of symbols that should be replaced with hyphens. ' Each symbol in the SymbolsToRemove array is checked, and if it's not a hyphen, ' it is replaced in the input string with a hyphen. Dim strSymbol As Variant For Each strSymbol In SymbolsToRemove If strSymbol <> "-" Then inputString = Replace(inputString, strSymbol, "-") End If Next strSymbol ReplaceSymbols = inputString End Function Private Function CleanHyphens(inputString As String) As String ' This function replaces double hyphens with a single hyphen and trims the input string. inputString = Trim(Replace(inputString, "--", "-")) ' Remove leading hyphens ' This loop checks if the first character of the input string is a hyphen. ' If it is, the hyphen is removed by taking the substring starting from the second character. Do While Left(inputString, 1) = "-" inputString = Mid(inputString, 2) Loop ' Remove trailing hyphens ' This loop checks if the last character of the input string is a hyphen. ' If it is, the hyphen is removed by taking the substring up to the second-to-last character. Do While Right(inputString, 1) = "-" inputString = Left(inputString, Len(inputString) - 1) Loop CleanHyphens = inputString End Function Private Sub AnalyzeDateParts(strPartOne As String, strPartTwo As String, strPartThree As String, _ ByRef intDay As Integer, ByRef intMonth As Integer, ByRef intYear As Integer) ' This subroutine analyzes the lengths of the date parts to determine their roles as day, month, or year. ' Depending on the format of the input string, it assigns the appropriate values to intYear, intMonth, and intDay. If Len(strPartOne) = 4 Then ' Year is first (Format: YYYY-MM-DD) intYear = CInt(strPartOne) intMonth = CInt(strPartTwo) intDay = CInt(strPartThree) ElseIf Len(strPartThree) = 4 Then ' Year is last (Format: DD-MM-YYYY) intYear = CInt(strPartThree) intMonth = CInt(strPartTwo) intDay = CInt(strPartOne) ElseIf Len(strPartTwo) = 4 Then ' Year is in the middle (Format: DD-YYYY-MM or MM-YYYY-DD) intYear = CInt(strPartTwo) If CInt(strPartOne) > 12 Then intDay = CInt(strPartOne) intMonth = CInt(strPartThree) ElseIf CInt(strPartThree) > 12 Then intDay = CInt(strPartThree) intMonth = CInt(strPartOne) Else intDay = CInt(strPartOne) intMonth = CInt(strPartThree) End If Else ' All parts are small numbers (Format: D-M-YY) intDay = CInt(strPartOne) intMonth = CInt(strPartTwo) intYear = CInt(strPartThree) ' Confirm year is in the correct range ' If the year is provided as a two-digit number, it will be treated as a year in the 2000s. If intYear < 100 Then intYear = intYear + 2000 End If End If End Sub Private Function IsValidDate(intDay As Integer, intMonth As Integer, intYear As Integer) As Boolean ' This function checks if the provided day, month, and year are valid. ' It verifies that the month is between 1 and 12 and that the day is appropriate ' for the given month and year (not exceeding 31 for any month). IsValidDate = (intMonth >= 1 And intMonth <= 12) And _ (intDay >= 1 And intDay <= 31) And _ (intYear >= 1900 And intYear <= 2100) End Function وللتجربة لكل الحالات تقريبا من داخل المحرر '************************************************************************************************************************************* ' Sub: TestRectifyDateFormat ' Purpose: This subroutine tests the RectifyDateFormat function with various input date strings ' to ensure that the function handles different formats and returns the expected results. ' ' Usage: Call TestRectifyDateFormat to run the tests and print the results to the debug output. ' '********************************************************************** ' Author: officena.net™ , Mohammed Essam © , soul-angel@msn.com ® ' Date: October 2024 '********************************************************************** Sub TestRectifyDateFormat() Dim testDate As String Dim result As Variant ' Test various date formats testDate = "30/11/2009" result = RectifyDateFormat(testDate) Debug.Print "Input: " & testDate & " | Result: " & result Debug.Print "-----------------------------------------------" testDate = "2012-06-25" result = RectifyDateFormat(testDate) Debug.Print "Input: " & testDate & " | Result: " & result Debug.Print "-----------------------------------------------" testDate = "21/6/2015م" result = RectifyDateFormat(testDate) Debug.Print "Input: " & testDate & " | Result: " & result Debug.Print "-----------------------------------------------" testDate = """ 9/1/2014""" result = RectifyDateFormat(testDate) Debug.Print "Input: " & testDate & " | Result: " & result Debug.Print "-----------------------------------------------" testDate = "30\11\2009" result = RectifyDateFormat(testDate) Debug.Print "Input: " & testDate & " | Result: " & result Debug.Print "-----------------------------------------------" testDate = "5/1999/26" result = RectifyDateFormat(testDate) Debug.Print "Input: " & testDate & " | Result: " & result Debug.Print "-----------------------------------------------" testDate = "25/1999/6" result = RectifyDateFormat(testDate) Debug.Print "Input: " & testDate & " | Result: " & result Debug.Print "-----------------------------------------------" testDate = "5/1994/ 26" result = RectifyDateFormat(testDate) Debug.Print "Input: " & testDate & " | Result: " & result Debug.Print "-----------------------------------------------" testDate = "5 1995 26" result = RectifyDateFormat(testDate) Debug.Print "Input: " & testDate & " | Result: " & result Debug.Print "-----------------------------------------------" testDate = "6 1996 26" result = RectifyDateFormat(testDate) Debug.Print "Input: " & testDate & " | Result: " & result End Sub RectifyDate.accdb

السلام عليكم ورحمة الله تعالى وبركاته تم تلافى الكثير من المشاكل وتم تحديث النسخة اليوم اليكم الاصدار الجديد ان شاء الله فى رأس الموضوع أو يمكنكم تحميل التعديل الاخيــر من >>---> تحميل التحديث للإصدار الأخير

ممكن توضيح اكثر يعنى اى قصدك من اضافة اى بيانات من مصدر خارجى ؟؟؟؟

فهم السؤال هو شطر الجواب ان لم يكن ثلثى الجواب والى الان لم يستطيع احد فهم السؤال المشكلة عند حضرتك فى عدم توضيح السؤال بشكل كاف وعدم وضع تصورات بشكل واف يا حبذا لو تضع النتيجة المطلوبة لاكثر من سجل

طيب وبعد التحليل للمرفق ومن غير اى اكواد ممكن جملة الاستعلام دى تحل لك كل مشاكلك SELECT Table1.code, Table1.test, Table1.result, Table2.Cal, Nz([result], 0)/Nz([Cal], 1) AS FinalCalc FROM Table1 INNER JOIN Table2 ON Table1.code = Table2.code; وما اخدت بالى من موضوع التقريب لو اردنا استخدام التقريب تكون جملة الاستعلام بالشكل التالى SELECT Table1.code, Table1.test, Table1.result, Table2.Cal, IIf(Nz([result], 0) <> 0 And Nz([Cal], 1) <> 0, Round(Nz([result], 0) / Nz([Cal], 1), 3), Nz([result], 0) / Nz([Cal], 1)) AS FinalCalc FROM Table1 INNER JOIN Table2 ON Table1.code = Table2.code; وهذا هو المرفق انظر الى الاستعلام مباشرة وغير القيم فى الحقل Cal تظهر لك النتيجة المرجوة مباشرة فى الحقل FinalCalc دا اذا كنت قدرت افهم انت عاوز ايه Cal error.accdb

انا حاولت اكثر من ساعة احاول افهم هو عاوز ايه ومقدرتش افهم والله على العمود طبعا انا اتفق تماما مع رأى استاذى الجليل و ومعلمى القدير و والدى الحبيب الاستاذ @ابوخليل ولأنه لم نفهم الية العمل او فكرة صاحب المسألة هذه فكرتى وظيفة ثغنونه وبنت حلال تعمل كل ده Function GetDLookupResult(code1 As Long, code2 As Long) As Double Dim result1 As Variant Dim result2 As Variant ' Retrieve the value from Table1 based on the passed values result1 = DLookup("result", "Table1", "[code] = " & code1) result2 = DLookup("result", "Table1", "[code] = " & code2) ' Check if the values are not null to avoid errors If IsNull(result1) Or IsNull(result2) Then GetDLookupResult = 0 ' Or return a blank value or an error message Exit Function End If ' Calculate the final result GetDLookupResult = result1 / result2 End Function مرر القيم التى تريد اليها بالشكل التالى من خلال زر الامر Dim finalResult As Double finalResult = GetDLookupResult(33, 36) Me.C = finalResult

جزاك الله خيرا الله يرحم والديك وكل المسلمين يارب

طيب من واقع مرفع حضرتك الاخير يا استاذ @UserUser2 ممكن نمشى خطوة خطوة اولا لما نفتح النموذج حضرتك عاوز تكتب ايه فى مربع النص ؟ وطبعا بناء على ما سوف يتم كتابته فى مربع النص نبتدى نفكر فى الكود على زر الامر خلينا بس نمشى خطوة تلو الاخرى لان لحد دلوقتى محدش قادر يفهم حضرتك عاوز تعمل ايه

فى الواقع يا استاذى الجليل و معلمى القدير و والدى الحبيب استاذ @jjafferr الخسارة الفعلية والحقيقية لنا نحن طلاب العلم من غياب اساتذتنا العظماء اركان هذا الصرح الشامخ والفضل كل الفضل لكم من بعد رب العزة سبحانه وتعالى شكر الله لكم حسن حلمكم وكرم اخلاقكم فى نقل خبراتكم وتعليمكم روعايتكم لنا ... جزاكم الله تعالى عنى وعن كل طلاب العلم كل الخير ويعلم الله انه منذ وقت انضمامى الى هذا الصرح الشامخ اول ما ابحث عنه عندما ادخل المنتدى ردود ومشاركات حضرتك واستاذى الجليل و ومعلمى القدير و والدى الحبيب الاستاذ @ابوخليل والاستاذ @أبو إبراهيم الغامدي والاستاذ @رمهان و الاستاذ @أبا عمر والاستاذ @SEMO.Pa3x و الاستاذ @أبو آدم وغيرهم الكثير الذين تعلمت انا شخصيا ولازلت حتى الان اتعلم من مشاركتهم حتى ولو كانت قديمه منهم من طال غيابه ومنهم من يدخل حسبما يسمح وقته اسأل الله تعالى لكل اساتذتى العظماء الذين ذكرتهم والذين لم اذكرهم ولكل من تعلمنا منهم وعلى ايديهم بكل حرف حسنه وان يضاعف لهم من فضله الكريم اضعافا مضاعفة واسأله ان يُكتب لهم فى موزاين اعمالهم علم ينتفع به وصدقة جارية الى يوم الدين ان شاء الله ... اللهم امين امين امين احبكم فى الله

اعتذر على التأخير اتفضل يا سيدى تم تحويل القاعدة للتنسيق 2000 بامتداد mdb الاكواد تعمل على النواتان 32 , 64 بيت Security(Enable-Disable Shift Key).zip

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

تم اضافة اصدار جديد لتنقيح وتفادى بعض الاخطاء بتاريخ 22/09/2024 - ضبط اسهم زيادة او نقصان الشهور والسنوات تبعا لترتيب واجهة ترتيب التواريخ ( يمين / يسار ) - ضبط الفتح التلقائى لقائمة السنوات او الشهور لاغلاقها اذا كانت مفتوحة بدلا من اعادة فتح القائمة مرة اخرى عند تكرارا الضغط رقم الاصدار الجديد 4 يمكن تحميل مرفق الاصدار الجديد من رأس الموضوع او من هنا Handler - calendar (V4).accdb