نجوم المشاركات

وعليكم السلام ورحمة الله تعالى وبركاته =TEXT((A4-INT(A4))*1000,"000")

ويمكن تحويله إلى نص إذا تجاوز 24 ساعة بشكل وقت عند الرغبة Times_02.accdb

وأفضل تكون المعادلة بدون عملية الطرح حيث أحيانا عملية الطرح تفقد الرقم جزء من دقته من واقع تجارب. كالتالي: = IF(FIND(".", A4, 1) = 0, 0, RIGHT(A4, FIND(".", A4, 1)) * 1000)

لو تبدل دالة Int بدالة Trunc أفضل حتى لا يتبدل الكسر مع المبالغ السالبة.

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

@ابوخليل أرجو الانتباه أنه تم التعديل على المرفق تعديلا بسيطا لا يؤثر على النتائج ولكنه الأصح بسبب قلة التركيز. التعديل في قوس الإغلاق للدالة يفترض أن يكون للوقت قبل عملية الضرب وليس بعد عملية الضرب. Me.txtResult1 = CDbl(Me.txtTime) * Me.txtMultip Me.txtResult2 = CDbl(Me.txtTime) * Me.txtMultip * 24 MsgBox Format(CDbl(Me.txtTime) * Me.txtMultip, "Short Time"), , _ Format(CDbl(Me.txtTime) * Me.txtMultip, "hh:mm")

لا لا لا يابو احمد غير معقول .. سطر واحد فقط .. هذا السطر هو بغيتي .. احط هذا السطر ميدالية مع المفاتيح لجماله CDbl(Me.txtTime * Me.txtMultip) * 24 مع كامل الاحترام والتقدير لكافة احبتي واخواني .. جزاكم الله خيرا وزادكم علما ورفعة .

Public Function MultiplyTime(strTime As String, factor As Double) As String On Error GoTo ErrHandler Dim totalMinutes As Double totalMinutes = TimeValue(strTime) * 24 * 60 * factor MultiplyTime = Format(totalMinutes / 24 / 60, "hh:nn") Exit Function ErrHandler: MultiplyTime = "خطأ في الوقت" End Function وللاستدعاء MultiplyTime("4:30", 5)

كلامك صحيح .. لم أقم بالتجربة على أرقام مختلفة .. في مديول :- Function MultiplyTime(ByVal tm As Date, ByVal factor As Long) As String Dim totalMinutes As Long totalMinutes = DateDiff("n", #12:00:00 AM#, tm) * factor MultiplyTime = Format(totalMinutes \ 60 & ":" & totalMinutes Mod 60, "hh:nn") End Function جرب على الإستدعاء من خلال الاستعلام :- SELECT MultiplyTime(#4:30#, 10) AS النتيجة

اقتراحي ان يتم تحويل الوقت الى ثواني لانها أدنا وحدة للوقت (هذه دالة تقوم بالتحويل) Public Function fncTimeToSec(varTime As Variant) As Double On Error GoTo OnErrors Dim curTime1 As Double If IsNull(varTime) Or varTime = "" Then fncTimeToSec = 0 Else If Len(varTime) > 5 Then curTime1 = CLng(Left(varTime, 2)) * 3600 curTime1 = curTime1 + CLng(Mid(varTime, 4, 2)) * 60 curTime1 = curTime1 + CLng(Mid(varTime, 7, 2)) Else curTime1 = CLng(Left(varTime, 2)) * 60 curTime1 = curTime1 + CLng(Mid(varTime, 4, 2)) End If fncTimeToSec = curTime1 End If ToExit: Exit Function OnErrors: fncTimeToSec = 0 Resume ToExit End Function ثم نقوم باجراء العملية الحسابية ثم نعيد تحويلها الى وقت بإستخدام هذه الدالة Public Function fncSecToTime(dblSeconds As Double) As String On Error GoTo OnErrors Dim curTime1 As Double If IsNull(dblSeconds) Or dblSeconds = 0 Then fncSecToTime = 0 Else curTime1 = Int(dblSeconds) fncSecToTime = Format(Int(curTime1 / 3600), "00") _ & ":" & Format(Int((curTime1 Mod 3600) / 60), "00") _ & ":" & Format((curTime1 Mod 3600) Mod 60, "00") End If ToExit: Exit Function OnErrors: fncSecToTime = 0 Resume ToExit End Function جرب وإن شاء الله تنجح مع تحياتي

لأجل هذه العبارة قمت بعمل تحديث على (الكاتب الذكي لدوال المجال) 😅🖐 قمت بإضافة خيارين للتعامل مع حقول التواريخ : (1) الخيار الأول : تحويلها إلى رقم من نوع Duble (2) الخيار الثاني : تنسيقه بالصيغة التالية : Format(varDate, "yyyy-mm-dd hh:nn:ss") وذلك لأنها الصيغة الأكثر توافقاً مع التنسيق القياسي (ISO) ستدخل على نفسي السرور إن تكرمت بتجربتها 👌 واجهة الأداة مع الخيارات الجديدة : 2nd_DomainFunctionsBuilder_V2.2.accdb

وعليكم السلام ورحمة الله وبركاته .. كمثال خطر ببالي من داخل استعلام على سبيل المثال :- SELECT Format(TimeValue("4:30") * 5, "hh:nn") AS النتيجة; أو استخدام الدالة CLng كمثال :- SELECT Format((CLng(#12/30/1899 4:30:0#*1440)*5)/1440,"Short Time") AS الناتج;

حفاظاً على محتوى الموضوع الجميل ، تم فتح موضوع منفصل للمشكلة التي صادفت أخونا @jo_2010 ، في هذا الرابط :-

تفضل أخي الكريم .. تعديلات وإضافة مرونة أكثر للإستخدام وتقليل التكرارات . في الدالة الرئيسية :- Public Function GetTxtHeight(annee As String, grade As String, wilaya As String, nomRapport As String) As Single Dim db As DAO.Database Dim rs As DAO.Recordset Dim hauteur As Single Set db = CurrentDb Set rs = db.OpenRecordset( _ "SELECT hauteur_rang FROM tab_hauteur_range " & _ "WHERE annee = '" & Replace(Trim(annee), "'", "''") & "' " & _ "AND grade = '" & Replace(Trim(grade), "'", "''") & "' " & _ "AND wilaya = '" & Replace(Trim(wilaya), "'", "''") & "' " & _ "AND nom_raport = '" & Replace(Trim(nomRapport), "'", "''") & "'", dbOpenSnapshot) If Not rs.EOF Then hauteur = Nz(rs!hauteur_rang, 0) * 567 Else hauteur = 0.7 * 567 End If rs.Close: Set rs = Nothing: Set db = Nothing GetTxtHeight = hauteur End Function دالة لتقليل تكرار عند فتح التقرير ، وإضافة مرونة في Tag مختلف من نفس الاستدعاء .. Public Sub ApplyHeightFromTempVars(ByVal rpt As Report, Optional ByVal tagMatch As String = "moho58") On Error GoTo SafeExit Dim h As Single Dim ctrl As Control h = Nz(TempVars!Temp_Hauteur, 0.7 * 567) For Each ctrl In rpt.Controls If ctrl.ControlType = acTextBox Then If LCase(Trim(Nz(ctrl.Tag, ""))) = LCase(tagMatch) Then ctrl.Height = h End If End If Next ctrl rpt.Section(acDetail).Height = h SafeExit: End Sub في أحدث عند النقر للأزرار :- Private Sub أمر2_Click() Dim h As Single h = GetTxtHeight(Me.annet, Me.grade1, Me.wilaya1, "rap_pv") TempVars!Temp_Hauteur = h DoCmd.OpenReport "rap_pv", acViewPreview End Sub Private Sub أمر3_Click() Dim h As Single h = GetTxtHeight(Me.annet, Me.grade1, Me.wilaya1, "rap_pv2") TempVars!Temp_Hauteur = h DoCmd.OpenReport "rap_pv2", acViewPreview End Sub في حدث عند الفتح في التقارير :- Private Sub Report_Open(Cancel As Integer) ApplyHeightFromTempVars Me ' ApplyHeightFromTempVars Me, "Foksh" تستطيع طبعاً استخدام تاج مختلف End Sub ملفك بعد التعديلات :- baseM5.zip

وانا باستخدم الكود ده فى وحده نمطية عامة Option Compare Database Option Explicit Public DebugMod As Boolean Public Function GenericDLookupPro( _ ByVal strFieldName As String, _ ByVal strTableName As String, _ ParamArray arrCriteria() As Variant) As Variant Dim strCriteria As String Dim lngIndex As Long Dim strField As String Dim strOperator As String Dim varValue As Variant Dim strOneCondition As String Dim db As DAO.Database Dim tdf As DAO.TableDef Dim fld As DAO.Field Dim intFieldType As Integer On Error GoTo ErrHandler Set db = CurrentDb ' تحقق من وجود الجدول أولًا If Not TableExists(strTableName, db) Then Err.Raise vbObjectError + 517, , "الجدول غير موجود: " & strTableName End If Set tdf = db.TableDefs(strTableName) ' تحقق من وجود الحقل المطلوب إرجاعه If Not FieldExists(strFieldName, tdf) Then Err.Raise vbObjectError + 518, , "الحقل غير موجود: " & strFieldName End If ' تأكد أن عدد عناصر المعايير من مضاعفات 3 If (UBound(arrCriteria) - lngIndex + 1) Mod 3 <> 0 Then Err.Raise vbObjectError + 514, , "يجب أن تكون المعايير على شكل ثلاثي: (الحقل، المعامل، القيمة)" End If Do While lngIndex <= UBound(arrCriteria) strField = CStr(arrCriteria(lngIndex)) If IsNull(arrCriteria(lngIndex + 1)) Then Err.Raise vbObjectError + 516, , "المعامل لا يمكن أن يكون Null" Else strOperator = Trim(UCase(CStr(arrCriteria(lngIndex + 1)))) End If varValue = arrCriteria(lngIndex + 2) ' التحقق من وجود الحقل If Not FieldExists(strField, tdf) Then Err.Raise vbObjectError + 519, , "الحقل '" & strField & "' غير موجود في الجدول '" & strTableName & "'" End If Set fld = tdf.Fields(strField) intFieldType = fld.Type ' بناء الشرط Select Case strOperator Case "IS NULL", "IS NOT NULL" strOneCondition = "[" & strField & "] " & strOperator Case "LIKE" strOneCondition = "[" & strField & "] LIKE '" & Replace(Nz(varValue, ""), "'", "''") & "'" Case "=", "<>", ">", "<", ">=", "<=" Select Case True Case IsNull(varValue) strOneCondition = "[" & strField & "] IS NULL" Case IsEmpty(varValue) Or varValue = "" strOneCondition = "[" & strField & "] = ''" Case intFieldType = dbText Or intFieldType = dbMemo Or intFieldType = dbGUID strOneCondition = "[" & strField & "] " & strOperator & " '" & Replace(CStr(varValue), "'", "''") & "'" Case intFieldType = dbDate strOneCondition = "[" & strField & "] " & strOperator & " #" & Format(CDate(varValue), "mm\/dd\/yyyy") & "#" Case Else strOneCondition = "[" & strField & "] " & strOperator & " " & varValue End Select Case Else Err.Raise vbObjectError + 515, , "المعامل غير مدعوم: " & strOperator End Select ' دمج الشرط If Len(strCriteria) > 0 Then strCriteria = strCriteria & " AND " strCriteria = strCriteria & strOneCondition lngIndex = lngIndex + 3 Loop If DebugMod Then Debug.Print "DLookup Criteria: " & strCriteria GenericDLookupPro = Nz(DLookup(strFieldName, strTableName, strCriteria), "لم يتم العثور على بيانات") CleanExit: Set fld = Nothing Set tdf = Nothing Set db = Nothing Exit Function ErrHandler: If DebugMod Then Debug.Print "خطأ في GenericDLookupPro: " & Err.Description GenericDLookupPro = Null Resume CleanExit End Function Private Function TableExists(TableName As String, db As DAO.Database) As Boolean Dim tdf As DAO.TableDef On Error Resume Next Set tdf = db.TableDefs(TableName) TableExists = Not tdf Is Nothing On Error GoTo 0 End Function Private Function FieldExists(FieldName As String, tdf As DAO.TableDef) As Boolean Dim fld As DAO.Field On Error Resume Next Set fld = tdf.Fields(FieldName) FieldExists = Not fld Is Nothing On Error GoTo 0 End Function ممكن حضرتك تجربه ليتم الاستدعاء من خلاله بالشكل التالى DebugMod = True Dim varResult As Variant varResult = GenericDLookupPro("date2", "tbl2", "date2", "=", Me.text1, "usr_id", "=", Me.text2) MsgBox varResult مرونة تامة في كتابة المعايير بصيغة: (اسم الحقل، المعامل، القيمة) دعم كامل للمعاملات: =, <>, >, <, >=, <=, LIKE, IS NULL, IS NOT NULL تحقق تلقائي من وجود الجدول والحقل تحليل ذكي لنوع الحقل (نصي، تاريخ، رقمي...) وبناء الشرط المناسب تلقائيا آمن ضد القيم الفارغة (Null, Empty, "") تتبع اختياري للتنفيذ في نافذة Immediate باستخدام DebugMod عند الحاجة الى التتبع والطباعة

أخي العزيز الأستاذ عبد اللطيف ، بداية هذه الرسالة تظهر وأعتقد لأنه يوجد لديك تطبيق واتس أب سطح المكتب .. حيث ، انظر لهذا السطر على سبيل المثال :- https://api.whatsapp.com/send/?phone=962787787573&text&type=phone_number&app_absent=0 لاحظ الرقم 0 في نهاية العنوان !! انظر لطبيعة ونوع الرسالة التي تظهر لك عندما يكون لديك تطبيق واتس اب سطح المكتب . ثم جرب وعدل 0 = 1 ، وانظر الفرق بين الرسالتين !!!! طبعاً في النهاية سيتم فتح التطبيق في حال تم تثبيته لأن له الأولوية على موقع الويب . لكن في نهاية المطاف ، لتجربة أن الكود يقوم فعلاً بتنفيذ المطلوب ، قم بحذف تطبيق الواتس اب لديك من الكمبيوتر ، وجربه ولاحظت أيضاً انه عندما لا يكون هناك ايميل ، فيظهر لك خطأ .. قم بإضافة هذا السطر في بداية حدث النقر لمربع النص الخاص بإرسال الإيميل Private Sub EMAIL_Click() If IsNull(Me.EMAIL) Or Me.EMAIL = "" Then Exit Sub

تفضل اخي ميزانية -اكسل-2023-.rar

السلام عليكم تفضل اخى الملف بعد تفعيل الماكرو جدول-تصفية-المنح-ابجد-هوز-صحيح2020-2021.rar