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

نوفمبر 23, 2021

تفضل اخي الكريم

         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

تحياتي

نوفمبر 23, 2021

11 دقائق مضت, بلال اليامين said:

اخي اريد 15 دقيقة لم تحسب

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

12 دقائق مضت, بلال اليامين said:

و اريد عند الحساب لم تفرغ الحقول

برجاء التوضيح اكثر ولك الشكر

تحياتي

نوفمبر 23, 2021

وتفضل هذه طريقة اخرى بعد تعديل مسيمات الحقول

        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

تحياتي

نوفمبر 22, 2021

وعليكم السلام ورحمة الله وبركاته

يمكنك استخدام الكود التالي

Format([TimeOut1]-[TimeIn1];"hh:nn:ss")

والافضل اخي بلال ان تكون مسميات العناصر باللغة اللاتينية لسهولة التعامل معها ولك الشكر

تحياتي

نوفمبر 22, 2021

وعليكم السلام ورحمة الله وبركاته

تفضل اخي الكريم

    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

تحياتي

نوفمبر 22, 2021

جزاك الله خيرا استاذنا الفاضل

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

وبالتأكيد الكل يريد زيادة في الجماية

تحياتي

نوفمبر 21, 2021

السلام عليكم

تفضل اخي الكريم

Me.text1 & vbNewLine & Me.text2

تحياتي

نوفمبر 18, 2021

السلام عليكم

حالياً يقرأ تلقائي من حقل

ولكن لا اردت التديل بحيث يكون عنصر الصورة غير منضم قم بتعديل الكود كالتالي

          Fpic.Picture = DLookup("Pic", "Code", "ID =" & Fid)
          Fpic0.Parent = DLookup("Pic0", "Code", "ID =" & Fid)

تحياتي

نوفمبر 18, 2021

وعليكم السلام ورحمة الله وبركاته

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

167219535_Screenshot2021-11-19010417.png.74334d39a1263be12a992fd72dbb9af2.png

تحياتي

نوفمبر 18, 2021

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

طريقة رائعة جدا وجديدة وفعالة

فبارك الله فيك واكثر من امثالك ونفعنا بك

تحياتي

نوفمبر 17, 2021

وعليكم السلام ورحمة الله وبركاته

تفضل اخي الكريم

ضع الكود التالي في زر الامر

        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

تحياتي

نوفمبر 16, 2021

وعليكم السلام ورحمة الله وبركاته

الشكل الجالي لن تستيطع تنفيذ المطلوب لانك تربد النموذج مستمر

لديك جدولين المفترض ان يكون احدهما راس الفاتورة والثاني تفاصيل الفاتورة

ثم تقوم بعمل علاقة بين الجدولين

ثم تقوم بتصميم نموذج راس الفاتورة نموذج مفرد

ثم تقوم بتصميم نموذج تفاصيل الفاتورة نموذج مستمر

ثم تضع نموذج تفاصيل الفاتورة داخل نموذج رأس الفاتورة في جزء تفصيل

مع ربط النموذجين ببعض كما فعلت سابقاً

تحياتي

نوفمبر 16, 2021

في ١٥‏/١١‏/٢٠٢١ at 10:32, abouelhassan said:

شكر وتقدير واحترام استاذ محمد بارك الله فيك هل نطمع بمثال بارك الله فيك

تفضل اخي الكريم

db1.rar

تحياتي

نوفمبر 15, 2021

وعليكم السلام ورحمة الله وبركاته

تفضل اخي الكريم

وجدت لك هذه الطريقة

ضع التالي في وحدة نمطية

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

تحياتي

نوفمبر 9, 2021

وعليكم السلام ورحمة الله وبركاته

        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

جرب الكود التالي كتبته بسرعة ولم اجربه وان شاء الله يفي بالغرض

تحياتي

نوفمبر 3, 2021

3 ساعات مضت, ابو فتحى said:

الخطا فى تكرار السجل الاول فى كل المربعات فى 30 مربع مع العلم هم 10 سجلات فقط فى استعلام

معك حق كان يوجد سطر قبل سطر

    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

تحياتي

نوفمبر 3, 2021

تفضل اخي الكريم

ملاحظة : تم تغيير اسماء مربعات النص

    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

تحياتي

نوفمبر 3, 2021

منذ ساعه, ابو فتحى said:

اخى العزيز استاذ jjafferr و Eng.Qassim

اولا شكرا على الرد و الاهتمام

ثانيا عندى اكتر من 300 مربع نض غير منضم فى نموذج غير منضم

المطلوبة جلب 300 كود موظف من جدوال العاملين ( سجل كود الموظف )

الى كل مربع نص فى النموذج بترتيب مثلا اول موظف كود 1001 الى مربع نص 1

ثانيا موظف كود 1106 الى مربع نص 2

تفضل اخي الكريم

    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

تحياتي

نوفمبر 3, 2021

3 ساعات مضت, ابو فتحى said:

هل يوجد كود لجلب بيانات جدوال او استعلام فى مربعات النص

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

تحياتي

نوفمبر 3, 2021

7 دقائق مضت, ابو فتحى said:

ممكن تغيير الرقم الى اكتر من 300 ام لا

يمكن بالتأكيد

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

تحياتي

نوفمبر 3, 2021

تفضل اخي الكريم

هذا الكود سيجلب لك 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

تحياتي

نوفمبر 3, 2021

وعليكم السلام ورحمة الله وبركاته

تفضل اخي الكريم

    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

تحياتي

نوفمبر 2, 2021

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

تحياتي

نوفمبر 2, 2021

تفضل اخي الكريم

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

تحياتي

نوفمبر 1, 2021

وعليكم السلام ورحمة الله وبركاته

تفضل اخي الكريم

يمكنك استخدام الكود التالي لاخفاء مربعات النص التي قيمتها = 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

تحياتي

تسجيل الدخول

المنتدى

مكتبة الموقع

معرض الصور

المدونات

الوسائط المتعددة

مشاركات المكتوبه بواسطه محمد أبوعبدالله

Important Information