کپی کردن یک متن در کلیپ بورد کامپیوتر در اکسس

[Shahramdindoust]

راستش در این سایت، در آدرس زیر -تالار vb- جواب رو دیدم ولی در اکسس کار نکرد
https://barnamenevis.org/showthread....88%D8%B1%D8%AF

اونجا از کد زیر استفاده می کردند
Clipborad.Clear
Clipboard.SetText Text1.Text





فکر کنم برای کپی کردن یک متن در کلیپ بورد کامپیوتر در اکسس باید یکم کد رو تغییر داد

[Shahramdindoust]

.............................

[amirzazadeh]

سلام
از این کد استفاده کنید:

Sub CopyToClipboard()

    Dim clipboard As MSForms.DataObject

    Dim strSample As String



    Set clipboard = New MSForms.DataObject

    strSample = "This is a sample string"

    

    clipboard.SetText strSample

    clipboard.PutInClipboard

End Sub

فقط باید Microsoft Forms 2.0 Object Library به لیست رفرنس ها اضافه بشه.

[Shahramdindoust]

ببخشید رفرنس مورد نظر رو پیدا نکردم و یک رفرنس شبیه به اون هست

Microsoft Fed

. اون رو هم زدم کار نکرد. و یک سوال هم دارم اگر اون رفرنس رو علامت کنم در خود فایل ذخیره میشه یا جزو تنظیمات کلی اکسس میشه. یعنی کاربر دیگه لازم نیست که اون رفرنس رو بزنه.
نمیدونم چرا کار نمیکنه .اگه زحمت نیست اون کار رو تکمیل نمایید کدهاش رو کپی کردم توی فایل
سپاس گذارم

[eb_1345]

ببخشید رفرنس مورد نظر رو پیدا نکردم و یک رفرنس شبیه به اون هست

Microsoft Fed

. اون رو هم زدم کار نکرد. و یک سوال هم دارم اگر اون رفرنس رو علامت کنم در خود فایل ذخیره میشه یا جزو تنظیمات کلی اکسس میشه. یعنی کاربر دیگه لازم نیست که اون رفرنس رو بزنه.
نمیدونم چرا کار نمیکنه .اگه زحمت نیست اون کار رو تکمیل نمایید کدهاش رو کپی کردم توی فایل
سپاس گذارم

از کدهای زیر استفاده کن!

Public Function Clipboard_GetText() As String

With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

     .GetFromClipboard

     Clipboard_GetText = .GetText

End With

End Function



Public Sub Clipboard_SetText(sInput As String)

With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

      .SetText sInput

      .PutInClipboard

End With

End Sub

بعد با استفاده از کد زیر متن text1 رو کپی کن

Call Clipboard_SetText(Text1)

و با کد زیر متن کپی شده در text2 پیست کن

Text2 = Clipboard_GetText

[Shahramdindoust]

[QUOTE=eb_1345;2439733]از کدهای زیر استفاده کن!


خیلی ممنون استاد با راهنمایی شما حل شد

[Shahramdindoust]

یک راه طولانی و نامناسب نیز هست که بدرد نمیخوره تو یه سایت دیدم همون پست 5 بهتره و عالیه

Option ExplicitPrivate Declare Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As Long

Private Declare Function EmptyClipboard Lib "user32.dll" () As Long

Private Declare Function CloseClipboard Lib "user32.dll" () As Long

Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long

Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long

Private Declare Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long

Private Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long

Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long

Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long

Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long

Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long





Public Sub SetClipboard(sUniText As String)

    Dim iStrPtr As Long

    Dim iLen As Long

    Dim iLock As Long

    Const GMEM_MOVEABLE As Long = &H2

    Const GMEM_ZEROINIT As Long = &H40

    Const CF_UNICODETEXT As Long = &HD

    OpenClipboard 0&

    EmptyClipboard

    iLen = LenB(sUniText) + 2&

    iStrPtr = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, iLen)

    iLock = GlobalLock(iStrPtr)

    lstrcpy iLock, StrPtr(sUniText)

    GlobalUnlock iStrPtr

    SetClipboardData CF_UNICODETEXT, iStrPtr

    CloseClipboard

End Sub





Public Function GetClipboard() As String

    Dim iStrPtr As Long

    Dim iLen As Long

    Dim iLock As Long

    Dim sUniText As String

    Const CF_UNICODETEXT As Long = 13&

    OpenClipboard 0&

    If IsClipboardFormatAvailable(CF_UNICODETEXT) Then

        iStrPtr = GetClipboardData(CF_UNICODETEXT)

        If iStrPtr Then

            iLock = GlobalLock(iStrPtr)

            iLen = GlobalSize(iStrPtr)

            sUniText = String$(iLen \ 2& - 1&, vbNullChar)

            lstrcpy StrPtr(sUniText), iLock

            GlobalUnlock iStrPtr

        End If

        GetClipboard = sUniText

    End If

    CloseClipboard

End Function