Excel Forum - Porady, Pomoc,  Excel Help, Excel FAQ Strona Główna
 FAQ  RegulaminRegulamin  Szukaj   Użytkownicy   Grupy   Rejestracja   Profil   Twoje wiadomości   Zaloguj 


Poprzedni temat «» Następny temat
ID tematu: 64470 Skopiuj do schowka Kopiowanie danych do schowka
Autor Wiadomość
Marti 
ExcelGaduła 500+



Wersja: Win Office 2010
Pomógł: 98 razy
Posty: 956
Wysłany: 18-03-2019, 11:38   Kopiowanie danych do schowka

Mam taki przykładowy kod:

Kod:
Public dtObj As New DataObject

Sub zaladuj_schowek()
Dim schowek As String
schowek = Range("A1").Value
dtObj.SetText schowek
dtObj.PutInClipboard
End Sub


"Wszędzie" działa i nie ma problemu, a u jednego kolegi niestety nie.
Nie wyrzuca żadnego błędu, ale do schowka Windows nic nie przenosi.
Zmienna schowek się uzupełnia i na tym koniec. Co może być przyczyną takiego stanu?
W innym pliku też jest zastosowany podobny kod i tam już u niego działa.
Z czym to się może "gryźć"?
_________________
Najlepszym dowodem na to, że w kosmosie istnieje inteligencja, jest to, że się z nami nie kontaktują.
ID posta: 364431 Skopiuj do schowka
 
 
Maciej Gonet 
Excel Expert


Wersja: Win Office 2016
Pomógł: 1286 razy
Posty: 4418
Wysłany: 18-03-2019, 13:57   

Czy w referencjach jest zaznaczone:
Kod:
Microsoft Forms 2.0 Object Library
ID posta: 364438 Skopiuj do schowka
 
 
ąćęłńóś
Excel Expert


Pomógł: 202 razy
Posty: 960
Wysłany: 18-03-2019, 19:57   

Może być co innego, Marti nic bowiem nie wspomina o "User-deined type not defined" .. : ( ... czyżby robota PutIn'a (?) ... : ) ...
... tak właściwie to dlaczego 'dtObj' jest taką "publiczną panią" ?

Ps:
Czyżby to było TO (?), ojoj ...

http://www.excelforum.pl/viewtopic.php?p=351948
ID posta: 364461 Skopiuj do schowka
 
 
J_B 
Excel Expert


Pomógł: 273 razy
Posty: 778
Wysłany: 18-03-2019, 20:46   

Może to taki przypadek Czytaj
Przyznaję nie studiowałem dokładnie tego wątku
API może załatwić sprawę
ID posta: 364464 Skopiuj do schowka
 
 
Marti 
ExcelGaduła 500+



Wersja: Win Office 2010
Pomógł: 98 razy
Posty: 956
Wysłany: 19-03-2019, 07:23   

Tak jak pisałem, w innym pliku też jest zastosowany podobny kod i tam już u niego działa.
Oczywiście odpowiednie referencje ma podpięte, bo nie wyrzuca żadnego błędu.
Zmienna 'dtObj' jest publiczna, bo używam ją w wielu innych procedurach - a co, tak jest źle? Mogę zamienić na lokalną, ale u mnie i u wielu innych osób to działa. A także w innym pliku kolegi.
Poczytam o tym przypadku co napisał J_B
_________________
Najlepszym dowodem na to, że w kosmosie istnieje inteligencja, jest to, że się z nami nie kontaktują.
ID posta: 364478 Skopiuj do schowka
 
 
Marti 
ExcelGaduła 500+



Wersja: Win Office 2010
Pomógł: 98 razy
Posty: 956
Wysłany: 15-04-2019, 08:22   

No dopadło również mojego kompa. Po ostatniej aktualizacji Win10 nie mam na liście referencji Microsoft Forms 2.0 Object Library, ale w lokalizacji C:\Windows\SysWOW64\FM20.dll plik istnieje :-?
Błędu "User-deined type not defined" Excel nie wyrzuca, ale schowek przestał działać. Pomocy :-(
_________________
Najlepszym dowodem na to, że w kosmosie istnieje inteligencja, jest to, że się z nami nie kontaktują.
ID posta: 366071 Skopiuj do schowka
 
 
Maciej Gonet 
Excel Expert


Wersja: Win Office 2016
Pomógł: 1286 razy
Posty: 4418
Wysłany: 15-04-2019, 09:05   

Zobacz, może o to chodzi.
ID posta: 366076 Skopiuj do schowka
 
 
OShon 
Excel Expert



Zaproszone osoby: 383
Wersja: Win Office 365
Pomógł: 1628 razy
Posty: 8299
Wysłany: 15-04-2019, 09:07   

Odwołanie się do .PutInClipboard to stara instrukcja i na W10 z nowym pakietem nie będzie już działać poprawnie. Polecam stosowane prze zemnie API zapięte w prostą w użyciu funkcję:
Kod:
Option Explicit

#If VBA7 Then
  Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
  Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As Long
  Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As LongPtr, ByVal dwBytes As LongPtr) As Long
  Declare PtrSafe Function CloseClipboard Lib "User32" () As Long
  Declare PtrSafe Function OpenClipboard Lib "User32" (ByVal hwnd As LongPtr) As Long
  Declare PtrSafe Function EmptyClipboard Lib "User32" () As Long
  Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
  Declare PtrSafe Function SetClipboardData Lib "User32" (ByVal wFormat As LongPtr, ByVal hMem As LongPtr) As Long
#Else
  Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
  Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
  Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
  Declare Function CloseClipboard Lib "User32" () As Long
  Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
  Declare Function EmptyClipboard Lib "User32" () As Long
  Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
  Declare Function SetClipboardData Lib "User32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
#End If

Public Const GHND = &H42
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096

Public Function ClipBoard_SetData(sPutToClip As String) As Boolean

    ' www.msdn.microsoft.com/en...e/ff192913.aspx

    Dim hGlobalMemory As Long
    Dim lpGlobalMemory As Long
    Dim hClipMemory As Long
    Dim X As Long
   
    On Error GoTo ExitWithError_

    ' Allocate moveable global memory
    hGlobalMemory = GlobalAlloc(GHND, Len(sPutToClip) + 1)

    ' Lock the block to get a far pointer to this memory
    lpGlobalMemory = GlobalLock(hGlobalMemory)

    ' Copy the string to this global memory
    lpGlobalMemory = lstrcpy(lpGlobalMemory, sPutToClip)

    ' Unlock the memory
    If GlobalUnlock(hGlobalMemory) <> 0 Then
        MsgBox "Memory location could not be unlocked. Clipboard copy aborted", vbCritical, "API Clipboard Copy"
        GoTo ExitWithError_
    End If

    ' Open the Clipboard to copy data to
    If OpenClipboard(0&) = 0 Then
        MsgBox "Clipboard could not be opened. Copy aborted!", vbCritical, "API Clipboard Copy"
        GoTo ExitWithError_
    End If

    ' Clear the Clipboard
    X = EmptyClipboard()

    ' Copy the data to the Clipboard
    hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
    ClipBoard_SetData = True
   
    If CloseClipboard() = 0 Then
        MsgBox "Clipboard could not be closed!", vbCritical, "API Clipboard Copy"
    End If
    Exit Function
ExitWithError_:
    On Error Resume Next
    If Err.Number > 0 Then MsgBox "Clipboard error: " & Err.Description, vbCritical, "API Clipboard Copy"
    ClipBoard_SetData = False

End Function
_________________
Oskar Shon - MVP Office System/Development 11/19r, 3x MCC
Forum moderator: Outlook.pl | ExcelForum.pl | MSDN dział VBA
Sprawdź promocje na polskie dodatki do MS Office w VBATools.pl
ID posta: 366077 Skopiuj do schowka
 
 
Marti 
ExcelGaduła 500+



Wersja: Win Office 2010
Pomógł: 98 razy
Posty: 956
Wysłany: 15-04-2019, 10:17   

OShon, dzięki wielkie :beer
Teraz "napełnianie" schowka działa bezbłędnie.

A jak wygląda sprawa z odczytywaniem danych z napełnionego schowka? Na razie mi to działa w takiej przerobionej formie:

Kod:
Dim dtObj As Object
Set dtObj = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
dtObj.GetFromClipboard
schowek = dtObj.GetText
_________________
Najlepszym dowodem na to, że w kosmosie istnieje inteligencja, jest to, że się z nami nie kontaktują.
ID posta: 366083 Skopiuj do schowka
 
 
OShon 
Excel Expert



Zaproszone osoby: 383
Wersja: Win Office 365
Pomógł: 1628 razy
Posty: 8299
Wysłany: 15-04-2019, 19:24   

eeee
Kod:
ActiveSheet.Paste

albo cokolwiek .Paste
np
Kod:
Range("f1").PasteSpecial
_________________
Oskar Shon - MVP Office System/Development 11/19r, 3x MCC
Forum moderator: Outlook.pl | ExcelForum.pl | MSDN dział VBA
Sprawdź promocje na polskie dodatki do MS Office w VBATools.pl
ID posta: 366115 Skopiuj do schowka
 
 
Marti 
ExcelGaduła 500+



Wersja: Win Office 2010
Pomógł: 98 razy
Posty: 956
Wysłany: 15-04-2019, 19:27   

Ale ja danych ze schowka nie wklejam całych do arkusza, tylko najpierw analizuję w pętli i wyciągam tylko to co mnie interesuje, a dopiero potem wklejam do wybranych komórek lub kontrolek. Potrzebuję zawartość schowka jako zmienną tekstową.
_________________
Najlepszym dowodem na to, że w kosmosie istnieje inteligencja, jest to, że się z nami nie kontaktują.
ID posta: 366116 Skopiuj do schowka
 
 
Tajan


Pomógł: 4351 razy
Posty: 9667
Wysłany: 15-04-2019, 20:27   

Do pobierania danych również możesz użyć API. Tutaj masz przykład:
https://docs.microsoft.com/en-us/office/vba/access/concepts/windows-api/retrieve-information-from-the-clipboard
ID posta: 366124 Skopiuj do schowka
 
 
Marti 
ExcelGaduła 500+



Wersja: Win Office 2010
Pomógł: 98 razy
Posty: 956
Wysłany: 16-04-2019, 07:26   

Dzięki Tajan.
Myślałem, że ta funkcja ClipBoard_GetData też pójdzie bez problemu, ale w moim wypadku niestety się sypie. Gdy w schowku przechowuję jakiś "standardowy" tekst to jest OK, ale przy wrzucaniu do schowka zawartości całej strony pewnej korporacyjnej aplikacji niestety nie daje rady. W schowku jest "niezły bałagan" (setki Chr(9), przejść do nowej linii, itd)
Nie mam dostępu do bazy aby wyciągać te dane sql'em, więc muszę sobie jakoś radzić inaczej. A ta aplikacja nie jest obsługiwana przez IE tylko przez FF.
Jak to poprawić (jedną linijkę już odznaczyłem ;-) )
Kod:
Function ClipBoard_GetData()
   Dim hClipMemory As Long
   Dim lpClipMemory As Long
   Dim MyString As String
   Dim RetVal As Long
 
   If OpenClipboard(0&) = 0 Then
      MsgBox "Cannot open Clipboard. Another app. may have it open"
      Exit Function
   End If
         
   hClipMemory = GetClipboardData(CF_TEXT)
   If IsNull(hClipMemory) Then
      MsgBox "Could not allocate memory"
      GoTo OutOfHere
   End If
 
   lpClipMemory = GlobalLock(hClipMemory)
 
   If Not IsNull(lpClipMemory) Then
      MyString = Space$(MAXSIZE)
      RetVal = lstrcpy(MyString, lpClipMemory)
      RetVal = GlobalUnlock(hClipMemory)
      'MyString = Mid(MyString, 1, InStr(1, MyString, Chr$(0), 0) - 1)
   Else
      MsgBox "Could not lock memory to copy string from."
   End If
 
OutOfHere:
 
   RetVal = CloseClipboard()
   ClipBoard_GetData = MyString
 
End Function
_________________
Najlepszym dowodem na to, że w kosmosie istnieje inteligencja, jest to, że się z nami nie kontaktują.
ID posta: 366145 Skopiuj do schowka
 
 
Tajan


Pomógł: 4351 razy
Posty: 9667
Wysłany: 16-04-2019, 09:20   

Ta linia jest potrzebna! Może masz zbyt małą wartość dla stałej MAXSIZE określającej maksymalną długość ciągu pobieranego ze schowka?
Ja tego kodu nie używałem, więc trudno mi wypowiedzieć się odnośnie innych szczegółów.
ID posta: 366149 Skopiuj do schowka
 
 
Marti 
ExcelGaduła 500+



Wersja: Win Office 2010
Pomógł: 98 razy
Posty: 956
Wysłany: 16-04-2019, 12:20   

Ustawiłem
Kod:
Public Const MAXSIZE = 32768

czyli 8 razy więcej niż pierwotne 4096. Nie wiem czy tak jest prawidłowo, ale działa ;-)
A ile można maksymalnie zadeklarować?
_________________
Najlepszym dowodem na to, że w kosmosie istnieje inteligencja, jest to, że się z nami nie kontaktują.
ID posta: 366159 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Nie możesz załączać plików na tym forum
Możesz ściągać załączniki na tym forum
Dodaj temat do Ulubionych
Wersja do druku

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Theme xandgreen created by spleen& Programosy modified v0.3 by warna
Opieka techniczna www.marketingNET.pl

Archiwum

Strona używa plików cookies.

Kliknij tutaj, żeby dowiedzieć się jaki jest cel używania cookies oraz jak zmienić ustawienia cookie w przeglądarce.
Korzystając ze strony użytkownik wyraża zgodę na używanie plików cookies, zgodnie z bieżącymi ustawieniami przeglądarki.
Sprawdź, w jaki sposób przetwarzamy dane osobowe