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

[Shahramdindoust]

راستش در این سایت، در آدرس زیر -تالار vb- جواب رو دیدم ولی در اکسس کار نکرد
https://barnamenevis.org/showthread.php?44268-%DA%A9%D9%BE%DB%8C-%DA%A9%D8%B1%D8%AF%D9%86-%D9%85%D8%AA%D9%86-%D8%A8%D9%87-%D8%AD%D8%A7%D9%81%D8%B8%D9%87-%DA%A9%D9%84%DB%8C%D9%BE%D8%A8%D9%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