نماذج التنقل

**jo_2010** · مايو 18, 2022

السادة الخبراء الافاضل

دمتم فى رعاية اللة

مرفق نموذج للتعديل وصورة لتوضيح المطلوب ولكم خالص الشكر

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

عند الضغط على مفتاح حرف U

اريد ان يفتح تبويب الباراسيتولوجى على نفس كود المريض الموجود بجوارة

**jo_2010** · مايو 19, 2022

نسخة جديدة من البرنامج تعمل بكفاءة

1 - Copy.rar

تم تعديل مايو 19, 2022 بواسطه jo_2010

**سامي الحداد** · مايو 19, 2022

اضف هذا الكود للزر U

Private Sub U_Click()

DoCmd.OpenForm "Para_Analysis", , , "[Pcode]=" & Me.PCode
Forms!Para_Analysis.SetFocus
Forms!Para_Analysis.Normal.SetFocus

End Sub

**jo_2010** · مايو 20, 2022

عزيزى الفاضل هل هذا الكود يفتح النموذج كانة نموذج منبثق

وانا اريد فتحة داخل التبويب الخاص بة بحيث يظهر النموذج الرئيسى امامى اثناء التنقل بين النماذج والتبويبات

تم تعديل مايو 20, 2022 بواسطه jo_2010

**jjafferr** · مايو 20, 2022

اما انا ، فلازلت ما قادر اوصل للزر U ، إلا في وضع التصميم ،

رجاء ترفق مرفق يعمل بكل ازراره ، وبدون اخطاء 🙂

جعفر

**jo_2010** · مايو 20, 2022

استاذى الفاضل أضف حضرتك اي زر في اي نموذج فرعي من النماذج الموجودة واجعلة يفتح اي تبويب من التبويبات الموجودة سواء كان الكيمياء او الباراسيتولوجي القاعدة حجمها كبير جدا وانا اقوم بمسح بعض النماذج والجدول والاستعلامات حتي استطيع إرسالها بعد ضغطها واعتقد انها تعمل افضل من السابقة

**jjafferr** · مايو 20, 2022

سيدي الفاضل 🙂

لا يوجد الكثير من المعلومات عن Navigation Control ، ولا Navigation Buttons !!

هذه النتائج توصلت اليها بعد عدة تجارب 🙂

رجاء وضع هذا الكود على حدث "عند النقر" على الزر U ،

وبدل الرقم 117 ، استعمل اسم الحقل الصحيح :

    
    DoCmd.BrowseTo acBrowseToForm, "General", , , "PA", acFormEdit
    Forms!General!PA.SetFocus
    SendKeys "~", True
    
    DoEvents
    
    Forms!General!JO.SetFocus
    
    Dim rst As DAO.Recordset
    
    Set rst = Forms!General!JO.Form.RecordsetClone
    
    rst.FindFirst "[PCode]=" & 117
    Forms!General!JO.Form.Bookmark = rst.Bookmark
    
    rst.close: Set rst = Nothing
    
      'TurnOnNumLock

.

الامر SendKeys يطفئ Key Pads لوحة المفاتيح ، فقد تحتاج الى امر يعيد فتحه ، فيمكنك استعمال الدالة التالية:

Option Compare Database
Option Explicit

Public Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Public Const VK_NUMLOCK = &H90

Public Sub TurnOnNumLock()

    If GetKeyState(VK_NUMLOCK) <> 1 Then
        SendKeys "{Numlock}", True
    End If

End Sub

.

ويمكنك مناداة الدالة هكذا (لاحظ سطر في اول كود اعطيتك) :

TurnOnNumLock

.

او بدل استعمال الامر SendKeys ، يمكنك استعمال الامر MySendkeys مع الدالة التالية:

'******** Code Start ***********
  'http://access.mvps.org/access/api/api0046.htm
  
      ' Declare Type for API call:
      Private Type OSVERSIONINFO
        dwOSVersionInfoSize As Long
        dwMajorVersion As Long
        dwMinorVersion As Long
        dwBuildNumber As Long
        dwPlatformId As Long
        szCSDVersion As String * 128   '  Maintenance string for PSS usage
      End Type

      ' API declarations:
      Private Declare PtrSafe Function GetVersionEx Lib "Kernel32" _
         Alias "GetVersionExA" _
         (lpVersionInformation As OSVERSIONINFO) As Long

      Private Declare ptrsafe Sub keybd_event Lib "user32" _
         (ByVal bVk As Byte, _
          ByVal bScan As Byte, _
          ByVal dwflags As Long, ByVal dwExtraInfo As Long)

      Private Declare ptrsafe Function GetKeyboardState Lib "user32" _
         (pbKeyState As Byte) As Long

      Private Declare ptrsafe Function SetKeyboardState Lib "user32" _
         (lppbKeyState As Byte) As Long

      ' Constant declarations:
      Const VK_NUMLOCK = &H90
      Const VK_SCROLL = &H91
      Const VK_CAPITAL = &H14
      Const KEYEVENTF_EXTENDEDKEY = &H1
      Const KEYEVENTF_KEYUP = &H2
      Const VER_PLATFORM_WIN32_NT = 2
      Const VER_PLATFORM_WIN32_WINDOWS = 1

Function IsCapsLockOn() As Boolean
        Dim o As OSVERSIONINFO

        o.dwOSVersionInfoSize = Len(o)
        GetVersionEx o
        Dim keys(0 To 255) As Byte
        GetKeyboardState keys(0)
        IsCapsLockOn = keys(VK_CAPITAL)
End Function

Sub ToggleCapsLock()
        Dim o As OSVERSIONINFO

        o.dwOSVersionInfoSize = Len(o)
        GetVersionEx o
        Dim keys(0 To 255) As Byte
        GetKeyboardState keys(0)

        If o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then  '=====Win95
        'Toggle capslock
            keys(VK_CAPITAL) = Abs(Not keys(VK_CAPITAL))
            SetKeyboardState keys(0)
        ElseIf o.dwPlatformId = VER_PLATFORM_WIN32_NT Then   '=====WinNT
          'Simulate Key Press>
            keybd_event VK_CAPITAL, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
          'Simulate Key Release
            keybd_event VK_CAPITAL, &H45, KEYEVENTF_EXTENDEDKEY _
               Or KEYEVENTF_KEYUP, 0
        End If
End Sub

Function IsNumLockOn() As Boolean
        Dim o As OSVERSIONINFO
        
        o.dwOSVersionInfoSize = Len(o)
        GetVersionEx o
        Dim keys(0 To 255) As Byte
        GetKeyboardState keys(0)
        IsNumLockOn = keys(VK_NUMLOCK)
End Function

Sub ToggleNumLock()
        Dim o As OSVERSIONINFO
                
        o.dwOSVersionInfoSize = Len(o)
        GetVersionEx o
        Dim keys(0 To 255) As Byte
        GetKeyboardState keys(0)

          If o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then  '=====Win95
                keys(VK_NUMLOCK) = Abs(Not keys(VK_NUMLOCK))
                SetKeyboardState keys(0)
          ElseIf o.dwPlatformId = VER_PLATFORM_WIN32_NT Then   '=====WinNT
          'Simulate Key Press
            keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
          'Simulate Key Release
            keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY _
               Or KEYEVENTF_KEYUP, 0
          End If
        
End Sub

Function IsScrollLockOn()
        Dim o As OSVERSIONINFO
        
        o.dwOSVersionInfoSize = Len(o)
        GetVersionEx o
        Dim keys(0 To 255) As Byte
        GetKeyboardState keys(0)
        IsScrollLockOn = keys(VK_SCROLL)
End Function

Sub ToggleScrollLock()
        Dim o As OSVERSIONINFO
        
        o.dwOSVersionInfoSize = Len(o)
        GetVersionEx o
        Dim keys(0 To 255) As Byte
        GetKeyboardState keys(0)
        If o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then  '=====Win95
            keys(VK_SCROLL) = Abs(Not keys(VK_SCROLL))
            SetKeyboardState keys(0)
        ElseIf o.dwPlatformId = VER_PLATFORM_WIN32_NT Then   '=====WinNT
            'Simulate Key Press
            keybd_event VK_SCROLL, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
            'Simulate Key Release
            keybd_event VK_SCROLL, &H45, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0
        End If
End Sub

Sub mySendKeys(sKeys As String, Optional bWait As Boolean = False)
Dim bNumLockState As Boolean
Dim bCapsLockState As Boolean
Dim bScrollLockState As Boolean
    bNumLockState = IsNumLockOn()
    bCapsLockState = IsCapsLockOn()
    bScrollLockState = IsScrollLockOn()
    SendKeys sKeys, bWait
    If IsNumLockOn() <> bNumLockState Then
        ToggleNumLock
    End If
    If IsCapsLockOn() <> bCapsLockState Then
        ToggleCapsLock
    End If
    If IsScrollLockOn() <> bScrollLockState Then
        ToggleScrollLock
    End If
End Sub

Function fSendKeys(sKeys As String, Optional bWait As Boolean = False)
' Function to make it callable from macros
    mySendKeys sKeys, bWait
End Function
'******** Code End ***********

جعفر

**jo_2010** · مايو 20, 2022

الخبير الفاضل jjafferr

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

هذا الكود يعمل بشكل رائع وقمت باستبدال 117 Me.ID اعطانى رسالة خطا

قمت باستبدال Me.ID rst.FindFirst "[PCode]=" & Forms!general!jo.form!Patient_Cach!ID اعطانى رسالة خطا ايضا واليك صورة الرسالة

DoCmd.BrowseTo acBrowseToForm, "General", , , "PA", acFormEdit
    Forms!General!PA.SetFocus
    SendKeys "~", True
    
    DoEvents
    
    Forms!General!JO.SetFocus
    
    Dim rst As DAO.Recordset
    
    Set rst = Forms!General!JO.Form.RecordsetClone
    
    rst.FindFirst "[PCode]=" & 117
    Forms!General!JO.Form.Bookmark = rst.Bookmark
    
    rst.close: Set rst = Nothing
    
      'TurnOnNumLock

تم تعديل مايو 20, 2022 بواسطه jo_2010

**jjafferr** · مايو 21, 2022

الحمدلله 🙂

خلينا من البداية نعطي قيمة ID الى متغير :

    dim myID as long

    myID= me.ID

    DoCmd.BrowseTo acBrowseToForm, "General", , , "PA", acFormEdit
    Forms!General!PA.SetFocus
    SendKeys "~", True
    
    DoEvents
    
    Forms!General!JO.SetFocus
    
    Dim rst As DAO.Recordset
    
    Set rst = Forms!General!JO.Form.RecordsetClone
    
    rst.FindFirst "[PCode]=" & myID
    Forms!General!JO.Form.Bookmark = rst.Bookmark
    
    rst.close: Set rst = Nothing
    
      'TurnOnNumLock

جعفر

تسجيل الدخول

نماذج التنقل

الردود الموصى بها

jo_2010

jo_2010

سامي الحداد

jo_2010

jjafferr

jo_2010

jjafferr

jo_2010

jjafferr

Join the conversation

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information