امر نسخ لجملة معينة عند تحميل النموذج

[Abdelaziz Osman]

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

لدى نموذج باسم open  اريد عند تحميل النموذج يقوم بنسخ تلقائى لجملة  "  P@12345678 "

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

[ناقل]

1 ساعه مضت, Abdelaziz Osman said:

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

لدى نموذج باسم open  اريد عند تحميل النموذج يقوم بنسخ تلقائى لجملة  "  P@12345678 "

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

تفضل ....

Private Sub Form_Load()
    ' نسخ النص إلى الحافظة
    Dim clipboard As Object
    Set clipboard = CreateObject("MSForms.DataObject")
    
    ' النص الذي تريد نسخه
    clipboard.SetText "P@12345678"
    clipboard.PutInClipboard
    
    MsgBox "تم نسخ النص إلى الحافظة!", vbInformation, "نسخ النص"
End Sub

 

[Abdelaziz Osman]

39 دقائق مضت, ناقل said:

تفضل ....

Private Sub Form_Load()
    ' نسخ النص إلى الحافظة
    Dim clipboard As Object
    Set clipboard = CreateObject("MSForms.DataObject")
    
    ' النص الذي تريد نسخه
    clipboard.SetText "P@12345678"
    clipboard.PutInClipboard
    
    MsgBox "تم نسخ النص إلى الحافظة!", vbInformation, "نسخ النص"
End Sub

 

اعطانى هذه الرسالة

[ناقل]

MSForms.DataObject يحتاج إلى تفعيل مكتبة Microsoft Forms 2.0 Object Library

[ناقل]

كود VBA باستخدام Windows API

وبدون تفعيل مكتبة

Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal uFormat As Long, ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As LongPtr
Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long

Const CF_TEXT As Long = 1
Const GMEM_MOVEABLE As Long = &H2

Sub CopyToClipboard(Text As String)
    Dim hGlobal As LongPtr
    Dim lpGlobal As LongPtr
    
    ' فتح الحافظة
    If OpenClipboard(0&) Then
        ' تفريغ الحافظة
        EmptyClipboard
        
        ' تخصيص ذاكرة للنص
        hGlobal = GlobalAlloc(GMEM_MOVEABLE, Len(Text) + 1)
        If hGlobal Then
            ' قفل الذاكرة وتعبئتها بالنص
            lpGlobal = GlobalLock(hGlobal)
            If lpGlobal Then
                CopyMemory ByVal lpGlobal, ByVal StrPtr(Text), Len(Text)
                GlobalUnlock hGlobal
                
                ' نسخ النص إلى الحافظة
                SetClipboardData CF_TEXT, hGlobal
            End If
        End If
        
        ' إغلاق الحافظة
        CloseClipboard
    End If
End Sub

Private Sub Form_Load()
    ' نسخ النص "P@12345678" عند تحميل النموذج
    CopyToClipboard "P@12345678"
    MsgBox "تم نسخ النص إلى الحافظة!", vbInformation, "نسخ النص"
End Sub

ملاحظات:

• الكود يدعم الأنظمة 64 بت (استخدم PtrSafe و LongPtr). إذا كنت تعمل على نظام 32 بت، يمكنك استبدال LongPtr بـ Long وحذف الكلمة PtrSafe.
• لا يحتاج إلى مكتبات خارجية.

[Abdelaziz Osman]

43 دقائق مضت, ناقل said:

MSForms.DataObject يحتاج إلى تفعيل مكتبة Microsoft Forms 2.0 Object Library

فعلت سيدى  وظهرت الرسالة ايضا

مرفق لك ملف العملية

open.zip

open.zip

تم تعديل ديسمبر 18 بواسطه Abdelaziz Osman

[ابوخليل]

مشاركة مع اخي وحبيبي الأستاذ ناقل 

علما انك لم تضف المكتبة التي اشار اليها الاستاذ ناقل Microsoft Forms 2.0 Object Library

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

اكتب في اي وحدة نمطية لديك في رأس الوحدة النمطية هذا السطر

Public Const myPassWord = "P@12345678"

وكلمة myPassWord هي التي تستخدمها لللأزرار 

[Abdelaziz Osman]

2 دقائق مضت, ابوخليل said:

مشاركة مع اخي وحبيبي الأستاذ ناقل 

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

اكتب في اي وحدة نمطية لديك في رأس الوحدة النمطية هذا السطر

Public Const myPassWord = "P@12345678"

وكلمة myPassWord هي التي تستخدمها لللأزرار 

مدير هل ممكن تطبيق الامر على ملف الاكسيس الذى قمت برفعه واعادة ارساله لى  ولك جزيل الشكر

25 دقائق مضت, ناقل said:

كود VBA باستخدام Windows API

وبدون تفعيل مكتبة

Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal uFormat As Long, ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As LongPtr
Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long

Const CF_TEXT As Long = 1
Const GMEM_MOVEABLE As Long = &H2

Sub CopyToClipboard(Text As String)
    Dim hGlobal As LongPtr
    Dim lpGlobal As LongPtr
    
    ' فتح الحافظة
    If OpenClipboard(0&) Then
        ' تفريغ الحافظة
        EmptyClipboard
        
        ' تخصيص ذاكرة للنص
        hGlobal = GlobalAlloc(GMEM_MOVEABLE, Len(Text) + 1)
        If hGlobal Then
            ' قفل الذاكرة وتعبئتها بالنص
            lpGlobal = GlobalLock(hGlobal)
            If lpGlobal Then
                CopyMemory ByVal lpGlobal, ByVal StrPtr(Text), Len(Text)
                GlobalUnlock hGlobal
                
                ' نسخ النص إلى الحافظة
                SetClipboardData CF_TEXT, hGlobal
            End If
        End If
        
        ' إغلاق الحافظة
        CloseClipboard
    End If
End Sub

Private Sub Form_Load()
    ' نسخ النص "P@12345678" عند تحميل النموذج
    CopyToClipboard "P@12345678"
    MsgBox "تم نسخ النص إلى الحافظة!", vbInformation, "نسخ النص"
End Sub

ملاحظات:

• الكود يدعم الأنظمة 64 بت (استخدم PtrSafe و LongPtr). إذا كنت تعمل على نظام 32 بت، يمكنك استبدال LongPtr بـ Long وحذف الكلمة PtrSafe.
• لا يحتاج إلى مكتبات خارجية.

هل اقوم بنسخ هذا الكود بالكامل ووضعه فى حدث عند التحميل

[ابوخليل]

تفضل

هذه الطريقة تستخدم لتخصيص المداخل ..

بمعنى كل مستخدم يمكنك تخصيص ازرار محددة له

طبعا مع تغيير بسيط في الاعلان عن المتغير

open2.rar

[Abdelaziz Osman]

24 دقائق مضت, ابوخليل said:

تفضل

هذه الطريقة تستخدم لتخصيص المداخل ..

بمعنى كل مستخدم يمكنك تخصيص ازرار محددة له

طبعا مع تغيير بسيط في الاعلان عن المتغير

open2.rar 88.34 kB · 0 downloads

الا يجوز وضع هذا السطر   DoCmd.RunCommand acCmdCopy = myPassWord

فى حدث عند تحميل النموذج    

[Abdelaziz Osman]

32 دقائق مضت, ابوخليل said:

تفضل

هذه الطريقة تستخدم لتخصيص المداخل ..

بمعنى كل مستخدم يمكنك تخصيص ازرار محددة له

طبعا مع تغيير بسيط في الاعلان عن المتغير

open2.rar 88.34 kB · 0 downloads

فكرة جيدة   ولكنى اريد عند تحميل النموذج ان يتم حفظ الباسوورد فى الحافظة حيث استخدم  ctrl+v  بعدها مباشرة

[Abdelaziz Osman]

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

[ناقل]

32 دقائق مضت, Abdelaziz Osman said:

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

جرب المرفق

 

open.accdb

Private Sub Form_Load()
Call CopyText("Pa@ 12345678")
End Sub
Public Function CopyText(ByVal Text As Variant) As Boolean
    CopyText = CreateObject("htmlfile").ParentWindow.ClipboardData.SetData("Text", Text)
End Function

 

[ابوخليل]

21 دقائق مضت, ناقل said:

جرب المرفق

 

open.accdb 968 kB · 2 downloads

Private Sub Form_Load()
Call CopyText("Pa@ 12345678")
End Sub
Public Function CopyText(ByVal Text As Variant) As Boolean
    CopyText = CreateObject("htmlfile").ParentWindow.ClipboardData.SetData("Text", Text)
End Function

 

سلمت اناملك 

[Abdelaziz Osman]

22 دقائق مضت, ناقل said:

جرب المرفق

 

open.accdb 968 kB · 3 downloads

Private Sub Form_Load()
Call CopyText("Pa@ 12345678")
End Sub
Public Function CopyText(ByVal Text As Variant) As Boolean
    CopyText = CreateObject("htmlfile").ParentWindow.ClipboardData.SetData("Text", Text)
End Function

 

اشكرك سيدى @ناقل

تم جزيل الشكر

[ناقل]

18 دقائق مضت, ابوخليل said:

سلمت اناملك 

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

18 دقائق مضت, Abdelaziz Osman said:

اشكرك سيدى @ناقل

تم جزيل الشكر

حياك اخي الكريم ... في الخدمه