"User3616725" den gelen yanıtla ilgili olası sorun:
Windows 8.1 üzerindeyim ve "user3616725" tarafından kabul edilen yanıttan bağlantılı VBA kodunda bir sorun var gibi görünüyor:
Sub CopyCellContents()
' !!! IMPORTANT !!!:
' CREATE A REFERENCE IN THE VBE TO "Microsft Forms 2.0 Library" OR "Microsft Forms 2.0 Object Library"
' DO THIS BY (IN VBA EDITOR) CLICKING TOOLS -> REFERENCES & THEN TICKING "Microsoft Forms 2.0 Library" OR "Microsft Forms 2.0 Object Library"
Dim objData As New DataObject
Dim strTemp As String
strTemp = ActiveCell.Value
objData.SetText (strTemp)
objData.PutInClipboard
End Sub
Ayrıntılar:
Kodun üstünde çalıştırma ve panoyu Excel'de bir hücreye yapıştırma, içinde soru işareti olan karelerden oluşan iki sembol alıyorum, örneğin: ⍰⍰. Not Defteri'ne yapıştırmak hiçbir şey göstermiyor bile.
Çözüm:
Bir süre aradıktan sonra , "Nepumuk" kullanıcısından Windows API kullanan başka bir VBA komut dosyası buldum . İşte sonunda benim için çalışan kodu:
Option Explicit
Private Declare Function OpenClipboard Lib "user32.dll" ( _
ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function EmptyClipboard Lib "user32.dll" () 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 GlobalFree Lib "kernel32.dll" ( _
ByVal hMem As Long) As Long
Private Declare Function lstrcpy Lib "kernel32.dll" ( _
ByVal lpStr1 As Any, _
ByVal lpStr2 As Any) As Long
Private Const CF_TEXT As Long = 1&
Private Const GMEM_MOVEABLE As Long = 2
Public Sub Beispiel()
Call StringToClipboard("Hallo ...")
End Sub
Private Sub StringToClipboard(strText As String)
Dim lngIdentifier As Long, lngPointer As Long
lngIdentifier = GlobalAlloc(GMEM_MOVEABLE, Len(strText) + 1)
lngPointer = GlobalLock(lngIdentifier)
Call lstrcpy(ByVal lngPointer, strText)
Call GlobalUnlock(lngIdentifier)
Call OpenClipboard(0&)
Call EmptyClipboard
Call SetClipboardData(CF_TEXT, lngIdentifier)
Call CloseClipboard
Call GlobalFree(lngIdentifier)
End Sub
Yukarıdan ilk VBA kodu gibi aynı şekilde kullanmak için, Alt "Beispiel ()" 'i şuradan değiştirin:
Public Sub Beispiel()
Call StringToClipboard("Hallo ...")
End Sub
Kime:
Sub CopyCellContents()
Call StringToClipboard(ActiveCell.Value)
End Sub
Ve kabul edilen yanıttan "user3616725" den önerildiği gibi Excel makro menüsü aracılığıyla çalıştırın:
Excel'e geri dönün, Araçlar> Makro> Makrolar'a gidin ve "İçeriği Kopyala" adlı makroyu seçin ve ardından iletişim kutusundan Seçenekler'i seçin. Burada makroyu bir kısayol tuşuna atayabilirsiniz (örneğin, normal kopyalama için Ctrl + c gibi) - Ctrl + q kullandım.
Ardından, tek bir hücreyi Not Defteri'ne / herhangi bir yere kopyalamak istediğinizde, Ctrl + q (veya ne seçerseniz seçin) yapın ve ardından Ctrl + v veya Düzenle> Yapıştır yapın.
Düzenleme (21 Kasım 2015):
@ "dotctor" dan yorum:
Hayır, bu cidden yeni bir soru değil! Benim düşünceme göre, cevabım, kabul edilen cevaptaki kodu kullanırken karşılaşabileceğiniz sorunları ele aldığından, kabul edilen cevap için iyi bir katkıdır. Daha fazla itibarım olsaydı, bir yorum yaratırdım.
"Teepeemm" den @ comment:
Evet, haklısın, "Sorun:" başlığıyla başlayan yanıtlar yanıltıcı. Şu şekilde değiştirildi: "" user3616725 "den gelen yanıtla ilgili olası sorun:". Bir yorum olarak kesinlikle çok daha kompakt yazardım.