Skip to main content

AccessTr.neT


Liste Kutusundaki Bir Veriyi Fonksiyon Tuşları Yardımıyla Kopyalamak

Liste Kutusundaki Bir Veriyi Fonksiyon Tuşları Yardımıyla Kopyalamak

Çözüldü #1
MErhaba arkadaşlar,
Ekteki veritabanımda faturaesle formunda bulunan listekutusundaki seçili herhangi bir alanı (örneğin faturano sütununda 3. satırı) fonksiyon tuşları yardımıyla kopyalamak istiyorum. Yani yapmak istediğim ilgili tabloda kopyalamak istediğim alanı bulup, sağ tuşa tıklayıp kopyala seçeneğini tıklama işlemini kısaltmak. Özetle üzeri seçili kaydın ilk sütununa CTRL+c yi bir fonksiyon tuşuna atamak istiyorum.

Örnekle izah edecek olursam; diyelim ki 3. satır seçili. Ben F5 tuşuna bastığımda, "deneme1" verisinin kopyalanmış olmasını istiyorum.
excel, outlook veya herhangi bir office uygulamasına sağ tuş tıklayıp yapıştır dediğimde bu verinin gelmesini istiyorum.


yardımlarınız için şimdiden teşekkürler.
.rar mehmetkopyala.rar (Dosya Boyutu: 315,36 KB | İndirme Sayısı: 2)
Cevapla
#2
Merhaba, 

1-) Formun "Tuş Önizleme" Özelliğini Evet olarak değiştir.

2-) Aşağıdaki kodları modüle kopyala ve modülü kaydet

Option Compare Database
Option Explicit

Private 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



3-) Listeesle isimli liste kutusunun Tuşa Basılırken olayına aşağıdaki kodu ekle

   If KeyCode = vbKeyF5 Then
   
   For i = 0 To Listeesle.ListCount - 1
       If Listeesle.Selected(i) = True Then
       
           SetClipboard (Listeesle.Column(1, i))
           MsgBox (Listeesle.Column(1, i))

       End If
   Next
   
   End If


liste kutusunda satır seçip f5'e bastığında veriyi kopyalar.
Cevapla
#3
f5 e bastığımda modülde Openclipboard'un üzeri seçili biçimde "sub of function not defined" uyarısı veriyor.
.rar mehmetkopyala-2.rar (Dosya Boyutu: 330,85 KB | İndirme Sayısı: 3)
Son Düzenleme: 29/08/2018, 15:14, Düzenleyen: mehmetb84.
Cevapla
#4
Modüldeki kodları aşağıdaki ile değiştirerek deneyiniz.

Option Compare Database
Option Explicit

Private Declare Function OpenClipboard Lib "user32" (ByVal Hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function EmptyClipboard Lib "user32" () 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
Cevapla
#5
Olmadı Ozan Bey, bin tane hata veriyor. Zaten çok elzem bir şey değil. Kalsın böyle. Tşkler ilginiz için.
Cevapla
#6
Alıntı:bin tane hata veriyor

Hatalardan birini yazarsanız çözüm arayabiliriz. 135 konunuza çözüm bulduk.
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task