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: 70223 Skopiuj do schowka Czyszczenie CLIPBOARD
Autor Wiadomość
Rufles 
ExcelGaduła 500+



Wersja: Win Office 2013
Posty: 589
Wysłany: 23-02-2021, 14:08   Czyszczenie CLIPBOARD

Hej, mam nie lada problem z czyszczeniem clipboard'a.
Poniższy kod nie czyści go. Jak mam to uczynić?
Kod:
Sub CopyAndClear()

Range("A1:A4").Copy
Range("C1").PasteSpecial xlPasteValues
Application.CutCopyMode = False

End Sub


Clipboard.xlsm
Pobierz Plik ściągnięto 4 raz(y) 12.19 KB

_________________
Rufles
ID posta: 400885 Skopiuj do schowka
 
 
Rufles 
ExcelGaduła 500+



Wersja: Win Office 2013
Posty: 589
Wysłany: 23-02-2021, 14:16   

Znalazłem taki kod na 64bit ale też nic nie robi a na pewno już nie czyści schowka office.

Kod:
Option Explicit

Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long

Sub ClearClipboard()
    OpenClipboard (0&)
    EmptyClipboard
    CloseClipboard
End Sub
_________________
Rufles
ID posta: 400888 Skopiuj do schowka
 
 
wczesny 
Stały bywalec Excelforum


Wersja: Win Office 2016
Pomógł: 31 razy
Posty: 269
Wysłany: 23-02-2021, 15:18   

U mnie makro nr 1 działa. Z czym masz dokładnie problem?
ID posta: 400897 Skopiuj do schowka
 
 
Rufles 
ExcelGaduła 500+



Wersja: Win Office 2013
Posty: 589
Wysłany: 23-02-2021, 15:21   

Makro działa ale nie czyści CLIPBOARD. Otwórz sobie schowek i zobacz że nie jest opróżniony.
_________________
Rufles
ID posta: 400898 Skopiuj do schowka
 
 
wczesny 
Stały bywalec Excelforum


Wersja: Win Office 2016
Pomógł: 31 razy
Posty: 269
Wysłany: 23-02-2021, 15:33   

No właśnie u mnie jest pusty.
Schowek musi być zamknięty podczas działania makra.

Edit:

Jak otworzyłem 2 raz schowek to przestało działać :(
  
ID posta: 400901 Skopiuj do schowka
 
 
Rufles 
ExcelGaduła 500+



Wersja: Win Office 2013
Posty: 589
Wysłany: 23-02-2021, 15:40   

U mnie się nie czyści, nawet jak jest zamknięty. I tu jest problem, czemu?
_________________
Rufles
ID posta: 400904 Skopiuj do schowka
 
 
wczesny 
Stały bywalec Excelforum


Wersja: Win Office 2016
Pomógł: 31 razy
Posty: 269
Wysłany: 23-02-2021, 15:55   

Bo to chyba nie służy do czyszczenia schowka, tylko usunięcia przerywanej ramki po kopiowaniu.
https://answers.microsoft.com/en-us/msoffice/forum/msoffice_excel-msoffice_custom-mso_365hp/excel-vba-clear-clipboard/a76f712a-097f-47bb-896f-6cd275429da4?page=2
  
ID posta: 400908 Skopiuj do schowka
 
 
Rufles 
ExcelGaduła 500+



Wersja: Win Office 2013
Posty: 589
Wysłany: 23-02-2021, 16:18   

Nie to nie to. Windows Clipboard mam wyłączony w ustawieniach. Ten co mi się nie chce wyczyścić to chyba Office Clipboard. Mam z tym nie lada problem bo po wykonaniu dużego makra z kopiowaniem obiektów po zamknięciu workbooka wywala mi błąd "The picture is too large and will be truncated". Jak tylko wyczyszczę Clipboard z Excela ręcznie wszystko jest ok. Muszę jakoś wyczyścić go z poziomu VBA.
Proszę o pomoc...
_________________
Rufles
ID posta: 400912 Skopiuj do schowka
 
 
Rufles 
ExcelGaduła 500+



Wersja: Win Office 2013
Posty: 589
Wysłany: 23-02-2021, 16:45   

OK chyba znalazłem kod który działa tak jak powinien. Dla tych co mają tez sam problem zamieszczam kod poniżej, który w całości czyści Office Clipboard.

Kod:
Option Explicit

Private Type POINTAPI
  x As Long
  Y As Long
End Type

Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
#If VBA7 Then
    Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
    Declare PtrSafe Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As LongPtr, ByVal wFlag As Long) As LongPtr
    Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
    Declare PtrSafe Function BringWindowToTop Lib "user32" (ByVal hwnd As LongPtr) As Long
    Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    #If Win64 Then
        Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "oleacc" (ByVal arg1 As LongPtr, ppacc As Any, pvarChild As Variant) As Long
    #Else
        Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "oleacc" (ByVal lX As Long, ByVal lY As Long, ppacc As IAccessible, pvarChild As Variant) As Long
    #End If
    Dim hwndClip As LongPtr
    Dim hwndScrollBar As LongPtr
    Dim lngPtr As LongPtr
#Else
    Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As Long, ByVal wFlag As Long) As Long
    Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long
    Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Declare Function AccessibleObjectFromPoint Lib "Oleacc" (ByVal lX As Long, ByVal lY As Long, ppacc As IAccessible, pvarChild As Variant) As Long
    Dim hwndClip As Long
    Dim hwndScrollBar As Long
#End If

Const GW_CHILD = 5
Const S_OK = 0

Sub ClearOfficeClipBoard()

    Dim tRect1 As RECT, tRect2 As RECT
    Dim tPt As POINTAPI
    Dim oIA As IAccessible
    Dim vKid  As Variant
    Dim lResult As Long
    Dim i As Long
    Static bHidden As Boolean
     
    If CommandBars("Office Clipboard").Visible = False Then
        bHidden = True
        CommandBars("Office Clipboard").Visible = True
        Application.OnTime Now, "ClearOfficeClipBoard": Exit Sub
    End If

    hwndClip = FindWindowEx(Application.hwnd, 0, "EXCEL2", vbNullString)
    hwndClip = FindWindowEx(hwndClip, 0, "MsoCommandBar", CommandBars("Office Clipboard").NameLocal)
    hwndClip = GetNextWindow(hwndClip, GW_CHILD)
    hwndScrollBar = GetNextWindow(GetNextWindow(hwndClip, GW_CHILD), GW_CHILD)
   
    If hwndClip And hwndScrollBar Then
        GetWindowRect hwndClip, tRect1
        GetWindowRect hwndScrollBar, tRect2
        BringWindowToTop Application.hwnd
        For i = 0 To tRect1.Right - tRect1.Left Step 50
            tPt.x = tRect1.Left + i: tPt.Y = tRect1.Top - 10 + (tRect2.Top - tRect1.Top) / 2
            #If VBA7 And Win64 Then
                CopyMemory lngPtr, tPt, LenB(tPt)
                lResult = AccessibleObjectFromPoint(lngPtr, oIA, vKid)
            #Else
                lResult = AccessibleObjectFromPoint(tPt.x, tPt.Y, oIA, vKid)
            #End If
            If InStr("Clear All - Borrar todo - Effacer tout", oIA.accName(vKid)) Then
                Call oIA.accDoDefaultAction(vKid): CommandBars("Office Clipboard").Visible = Not bHidden: bHidden = False: Exit Sub
            End If
            DoEvents
        Next i
    End If
    CommandBars("Office Clipboard").Visible = Not bHidden
    MsgBox "Unable to clear the Office Clipboard"

End Sub
_________________
Rufles
ID posta: 400914 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