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

Abdelaziz Osman · الأربعاء at 07:22

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

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

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

**ناقل** · الأربعاء at 09:18

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 · الأربعاء at 09:58

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

image.png.0fdc3597bcaafaf633580d59497cf40d.png اعطانى هذه الرسالة

**ناقل** · الأربعاء at 10:30

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

**ناقل** · الأربعاء at 11:03

كود 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 · الأربعاء at 11:08

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

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

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

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

image.png.299026d17a358543bcafab565697fd28.png open.zip

open.zip

تم تعديل الأربعاء at 11:16 بواسطه Abdelaziz Osman

**ابوخليل** · الأربعاء at 11:24

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

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

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

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

Public Const myPassWord = "P@12345678"

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

Abdelaziz Osman · الأربعاء at 11:27

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.
لا يحتاج إلى مكتبات خارجية.

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

**ابوخليل** · الأربعاء at 11:46

تفضل

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

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

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

open2.rar

Abdelaziz Osman · الأربعاء at 12:13

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

تفضل

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

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

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

open2.rar 88.34 kB · 0 downloads

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

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

Abdelaziz Osman · الأربعاء at 12:20

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

تفضل

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

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

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

open2.rar 88.34 kB · 0 downloads

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

Abdelaziz Osman · الأربعاء at 12:49

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

**ناقل** · الأربعاء at 13:22

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

**ابوخليل** · الأربعاء at 13:44

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

سلمت اناملك :clapping:

Abdelaziz Osman · الأربعاء at 13:45

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

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

تم جزيل الشكر

**ناقل** · الأربعاء at 14:03

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

سلمت اناملك

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

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

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

تم جزيل الشكر

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

تسجيل الدخول

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

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

Abdelaziz Osman

ناقل

Abdelaziz Osman

ناقل

ناقل

ملاحظات:

Abdelaziz Osman

ابوخليل

Abdelaziz Osman

ملاحظات:

ابوخليل

Abdelaziz Osman

Abdelaziz Osman

Abdelaziz Osman

ناقل

ابوخليل

Abdelaziz Osman

ناقل

Join the conversation

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

تصفح الموقع

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

Support

Important Information