محمد أبوعبدالله

تفضل اخي الكريم Me.TotalTime11 = Int(DateDiff("h", Me.TimeIn1, Me.TimeOut1)) Me.TotalTime12 = Int(DateDiff("h", Me.TimeIn2, Me.TimeOut2)) Me.TotalTime13 = Int(DateDiff("h", Me.TimeIn3, Me.TimeOut3)) Me.TotalTime14 = Int(DateDiff("h", Me.TimeIn4, Me.TimeOut4)) Me.TotalTime15 = Int(DateDiff("h", Me.TimeIn5, Me.TimeOut5)) Me.TotalTimeALL = Me.TotalTime11 + Me.TotalTime12 + Me.TotalTime13 + Me.TotalTime14 + Me.TotalTime15 & " ساعة" &&ساعات.rar تحياتي

في الاستعلام الموجود يقوم بحساب الساعات فقط ... ما الجديد الذي تريده ؟ برجاء التوضيح اكثر ولك الشكر تحياتي

وتفضل هذه طريقة اخرى بعد تعديل مسيمات الحقول Me.TotalTime11 = TimeSerial(Hour([TimeIn1]) - Hour([TimeOut1]), Minute([TimeIn1]) - Minute([TimeOut1]), Second([TimeIn1]) - Second([TimeOut1])) Me.TotalTime12 = TimeSerial(Hour([TimeIn2]) - Hour([TimeOut2]), Minute([TimeIn2]) - Minute([TimeOut2]), Second([TimeIn2]) - Second([TimeOut2])) Me.TotalTime13 = TimeSerial(Hour([TimeIn3]) - Hour([TimeOut3]), Minute([TimeIn3]) - Minute([TimeOut3]), Second([TimeIn3]) - Second([TimeOut3])) Me.TotalTime14 = TimeSerial(Hour([TimeIn4]) - Hour([TimeOut4]), Minute([TimeIn4]) - Minute([TimeOut4]), Second([TimeIn4]) - Second([TimeOut4])) Me.TotalTime15 = TimeSerial(Hour([TimeIn5]) - Hour([TimeOut5]), Minute([TimeIn5]) - Minute([TimeOut5]), Second([TimeIn5]) - Second([TimeOut5])) Me.TotalTimeALL = Me.TotalTime11 + Me.TotalTime12 + Me.TotalTime13 + Me.TotalTime14 + Me.TotalTime15 &&ساعات.rar تحياتي

وعليكم السلام ورحمة الله وبركاته يمكنك استخدام الكود التالي Format([TimeOut1]-[TimeIn1];"hh:nn:ss") والافضل اخي بلال ان تكون مسميات العناصر باللغة اللاتينية لسهولة التعامل معها ولك الشكر تحياتي

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم Dim db As Object Dim rst As DAO.Recordset Set rst = CurrentDb.OpenRecordset("FILR") rst.AddNew rst.Fields(0) = Nz(DMax("[المعرف]", "FILR"), 0) + 1 rst.Fields(1) = Me.اسم_الموظف rst.Fields(2) = Me.Cat4_Sum rst.Update rst.Close Set rst = Nothing 2222.rar تحياتي

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

السلام عليكم تفضل اخي الكريم Me.text1 & vbNewLine & Me.text2 تحياتي

السلام عليكم حالياً يقرأ تلقائي من حقل ولكن لا اردت التديل بحيث يكون عنصر الصورة غير منضم قم بتعديل الكود كالتالي Fpic.Picture = DLookup("Pic", "Code", "ID =" & Fid) Fpic0.Parent = DLookup("Pic0", "Code", "ID =" & Fid) تحياتي

وعليكم السلام ورحمة الله وبركاته يمكنك التحكم بظهور الارقام كما بالصورة تحياتي

جزاك الله خيرا اخي الكريم طريقة رائعة جدا وجديدة وفعالة فبارك الله فيك واكثر من امثالك ونفعنا بك تحياتي

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم ضع الكود التالي في زر الامر Me.list0.RowSource = "SELECT data.ID, data.pname, request.Age, data.Telephone, request.rdate, request.[no], request.Doctor, request.Price " & vbCrLf & _ "FROM data INNER JOIN request ON data.ID = request.id WHERE (((request.rdate) Between [Forms]![mm]![FROM] And [Forms]![mm]![To])) ORDER BY data.ID;" Me.list0.Requery Me.text5 = Me.list0.ListCount - 1 Dim XSum As Integer Dim i As Integer XSum = 0 For i = 1 To Me.list0.ListCount - 1 XSum = XSum + Me.list0.Column(7, i) Next Me!soso = XSum listbox.rar تحياتي

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

تفضل اخي الكريم db1.rar تحياتي

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم وجدت لك هذه الطريقة ضع التالي في وحدة نمطية Option Compare Database Option Explicit #If VBA7 Then Private Declare PtrSafe Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, _ ByVal dwFlags As LongPtr, ByVal dwExtraInfo As LongPtr) Private Declare PtrSafe Function GetKeyboardState Lib "user32.dll" (ByVal lpKeyState As LongPtr) As Boolean #Else Private Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, _ ByVal dwFlags As Long, ByVal dwExtraInfo As Long) Private Declare Function GetKeyboardState Lib "user32.dll" (ByVal lpKeyState As Long) As Boolean #End If Private Const KEYEVENTF_EXTENDEDKEY As Long = &H1 Private Const KEYEVENTF_KEYUP As Long = &H2 Private Const VK_NUMLOCK As Byte = &H90 Private Const NumLockScanCode As Byte = &H45 Public Sub ToggleNumlock(enabled As Boolean) Dim keystate(255) As Byte 'Test current keyboard state. GetKeyboardState (VarPtr(keystate(0))) If (Not keystate(VK_NUMLOCK) And enabled) Or (keystate(VK_NUMLOCK) And Not enabled) Then 'Send a keydown keybd_event VK_NUMLOCK, NumLockScanCode, KEYEVENTF_EXTENDEDKEY, 0& 'Send a keyup keybd_event VK_NUMLOCK, NumLockScanCode, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0& End If End Sub واستخدمها بالكود التالي 'Turn Numlock off. ToggleNumlock False 'Turn Numlock on. ToggleNumlock True تحياتي

وعليكم السلام ورحمة الله وبركاته mySQL = "Select * From tblNumbers" Set rst = CurrentDb.OpenRecordset(mySQL) rst.MoveLast: rst.MoveFirst Dim i As Integer For i = 1 To 200 rst.Edit If rst!imgs = "C:\military\img\" & i & ".png" Then rst!imgs = "C:\military\img\" & i + 1 & ".png" End If rst.Update rst.MoveNext Next جرب الكود التالي كتبته بسرعة ولم اجربه وان شاء الله يفي بالغرض تحياتي

معك حق كان يوجد سطر قبل سطر Dim db As Object Dim rst As DAO.Recordset Dim mySQL As String Dim i As Integer mySQL = "Select * From qvode" Set rst = CurrentDb.OpenRecordset(mySQL) If Not rst.BOF Then rst.MoveFirst Dim ctl As Control For i = 1 To 10 Me.Controls("Textbox" & i) = rst!CODE rst.MoveNext Next i rst.Close Set rst = Nothing تحياتي

تفضل اخي الكريم ملاحظة : تم تغيير اسماء مربعات النص Dim db As Object Dim rst As DAO.Recordset Dim mySQL As String Dim i As Integer mySQL = "Select * From qvode" Set rst = CurrentDb.OpenRecordset(mySQL) If Not rst.BOF Then rst.MoveFirst Dim ctl As Control For i = 1 To 30 Me.Controls("Textbox" & i) = rst!CODE Next i rst.MoveNext rst.Close Set rst = Nothing db1.rar تحياتي

تفضل اخي الكريم Dim db As Object Dim rst As DAO.Recordset Dim mySQL As String Dim i As Integer mySQL = "Select * From table_name" Set rst = CurrentDb.OpenRecordset(mySQL) If Not rst.BOF Then rst.MoveFirst Dim ctl As Control For i = 1 To 300 Me.Controls("Textbox" & i) = rst.Fields(i) rst.MoveNext Next i rst.Close Set rst = Nothing تحياتي

بالطريقة السابقة يمكن باذن الله تحياتي

يمكن بالتأكيد ولكن لا يوجد جدول او استعلام استيعاب اكثر من 255 حقل تحياتي

تفضل اخي الكريم هذا الكود سيجلب لك 254 حقل من جدول table_name مع مراعاة ان يكون ان تكون اسماء مربعات النص الغير منضمة متالية الترقيم ( Textbox1 - Textbox2 >>>>> ) Dim db As Object Dim rst As DAO.Recordset Dim mySQL As String Dim i As Integer mySQL = "Select * From table_name" Set rst = CurrentDb.OpenRecordset(mySQL) If Not rst.BOF Then rst.MoveFirst Dim ctl As Control For i = 1 To 254 Me.Controls("Textbox" & i) = rst.Fields(i) Next i rst.Close Set rst = Nothing تحياتي

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم Dim db As Object Dim rst As DAO.Recordset Dim mySQL As String mySQL = "Select * From table_name" Set rst = CurrentDb.OpenRecordset(mySQL) If Not rst.BOF Then rst.MoveFirst While (Not rst.EOF) Me.TextBox1 = rst.Fields(0) Me.TextBox2 = rst.Fields(1) Me.TextBox3 = rst.Fields(2) ' >>>>>>>>>>>>>>>>>> ' >>>>>>>>>>>>>>>>>> ' >>>>>>>>>>>>>>>>>> Wend rst.Close Set rst = Nothing تحياتي

جزاك الله خيرا اخي الكريم تحياتي

تفضل اخي الكريم Function ChangeProperty(strPropName As String, varPropType As Variant, varPropValue As Variant) As Integer Dim dbs As Object Dim prp As Variant Const conPropNotFoundError = 3270 Set dbs = CurrentDb On Error GoTo Change_Err dbs.Properties(strPropName) = varPropValue ChangeProperty = True Change_Bye: Exit Function Change_Err: If Err = conPropNotFoundError Then ' Property not found. Set prp = dbs.CreateProperty(strPropName, _ varPropType, varPropValue) dbs.Properties.Append prp Resume Next Else ' Unknown error. ChangeProperty = False Resume Change_Bye End If End Function Lock shift.rar تحياتي

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم يمكنك استخدام الكود التالي لاخفاء مربعات النص التي قيمتها = 0 Dim ctl As Control For Each ctl In Me.Controls If ctl.ControlType = acTextBox Then If ctl.Value = 0 Then ctl.Visible = False End If Next ctl hid.rar تحياتي