Vider presse-papiersRésolu

Question

Bonjour,

J'ai réalisé un fichier excel avec une macro en VBA qui me permet notamment de réaliser des captures d'écran (ces captures sont issues d'un logiciel ouvert à côté, puis collées dans mon fichier excel).

Cependant, ce logiciel dont sont issues mes captures est relativement instable et plante donc très souvent. Du coup, ma macro n'a pas eu le temps de réaliser toutes mes captures.

Le problème est que ma macro (de temps en temps  ) force quand même le collage. Mais vous me direz "si le copier n'a pas pu se faire, qu'est-ce qui est collé ?!?", et vous avez raison de me demander cela ! Eh bien ce sont des pièces issues de mon presse-papiers office qui sont collées, c'est-à-dire tout et n'importe quoi !

Et vu que vous êtes malins, vous me dites "tu n'as qu'à vider ton presse-papiers idiot, ça t'éviteras de coller quelque chose non-désiré !", et vous avez encore une fois raison !

Mais vu que je suis fainéant, je souhaite le vider automatiquement dans ma macro... mais je n'y arrive pas... 

J'ai donc recherché comment le faire et testé différentes solutions, sans succès à l'heure actuelle.

Voici ce que j'ai testé :

Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
 
Private Sub Commande0_Click()
    OpenClipboard 0
    EmptyClipboard
    CloseClipboard
End Sub

ou bien :

sub vide_PP()
 On Error Resume Next
 Application.CommandBars("Clipboard").Controls(4).Execute
 end sub

ou encore :

Application.CutCopyMode = False

voire même :

Clipboard.Clear

et aussi :

Dim oDataObject As DataObject 
 
Set oDataObject = New DataObject 
oDataObject.SetText "" 
oDataObject.PutInClipboard 
 
Set oDataObject = Nothing 

(j'ai même peut-être testé d'autres choses, mais je ne m'en rappelle plus...)


Donc si vous avez une idée, n'hésitez surtout pas à me la donner ! 

Merci !

CTAC · Accepted Answer

Bonjour,

Voici du code de Michel Pierron qui permet de vider le presse-papier office.
A metre dans un module standard

ctac


Commentaire de Michel Pierron :

Petit rappel; depuis xl2000, Excel contient plusieurs presse-papiers privés
dont seul le premier est commun avec Windows. Dans ces versions, le
presse-papiers n'est pas accessible par programmation VBA.
Cependant, il est possible de contourner le problème en utilisant les
fonctions API de Microsoft ActiveAccessibility qui permettent d'explorer les
éléments contenus dans une fenêtre. Ce n'est pas simple et cela demande un
peu de code.
L'exploration se faisant sur les captions des éléments, ces derniers sont
différemment nommés en fonction de la langue de l'application.
Tu peux t'inspirer de la procédure ci-dessous dans laquelle on s'assure que
lê volet Office est affiché et qu'il est positionné sur le presse-papiers;
on recherche ensuite l'élément qui porte le nom "Effacer tout" sur lequel on
simule un click s'il est trouvé




Option Explicit
Private Declare Function EnumChildWindows& Lib "user32" _
(ByVal hWndParent&, ByVal lpEnumFunc&, ByVal lParam&)
Private Declare Function FindWindow& Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function GetClassName& Lib "user32" Alias _
"GetClassNameA" (ByVal hwnd&, ByVal lpClassName$, ByVal nMaxCount&)
Private Declare Function GetWindowText& Lib "user32" Alias _
"GetWindowTextA" (ByVal hwnd&, ByVal lpString$, ByVal cch&)
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(8) As Byte
End Type
Private Declare Function IIDFromString& Lib "ole32" _
(ByVal lpsz$, ByRef lpiid As GUID)
Private Declare Function AccessibleObjectFromWindow& Lib "oleacc" _
(ByVal hwnd&, ByVal dwId&, riid As GUID, ppvObject As Object)
Private Declare Function AccessibleChildren& Lib "oleacc" _
(ByVal paccContainer As IAccessible, ByVal iChildStart& _
, ByVal cChildren&, rgvarChildren As Variant, pcObtained&)
Private Type AccObject
oIA As IAccessible
hwnd As Long
End Type
Private hChild&, sClass$, sCaption$

Sub ClearAll()
Call ClipBoardAction(False)
End Sub

Sub PasteAll()
Range("A1").Select    ' Where paste all elements
Call ClipBoardAction(True)
End Sub

Private Sub ClipBoardAction(Optional PasteAll As Boolean = False)
Dim S%: S = Application.CommandBars("Task Pane").Visible
If Not GoodVersion Then Exit Sub
Dim hwnd As Long
hwnd = FindWindow(vbNullString, Application.Caption)
hChild = 0
sCaption = Application.CommandBars("Task Pane").NameLocal
sClass = "MsoCommandBar"
EnumChildWindows hwnd, AddressOf EnumChildProc, ByVal 0&
If hChild Then
' English version: "Paste all" & "Clear all"
If PasteAll Then Call ClipboardExec(hChild, "Coller tout")
Call ClipboardExec(hChild, "Effacer tout")
End If
If S Then Exit Sub
'Application.CommandBars(1).FindControl(ID:=5746, Recursive:=True).Execute
End Sub

Private Function GoodVersion() As Boolean
GoodVersion = Val(Application.Version) > 9
If Not GoodVersion Then GoTo 1
Application.CommandBars(1).FindControl(ID:=809, Recursive:=True).Execute
Exit Function
1: MsgBox "Votre version d'Excel ne supporte pas cette méthode !", 64
End Function

' Using Active Accessibility to execute Office clipboard action
Private Function ClipboardExec(ByVal hwnd&, sName$) As Boolean
Dim oBtn As AccObject
' Get the IAccessible interface and child id
oBtn = Find_IAO(hwnd, sName)
If oBtn.oIA Is Nothing Then
MsgBox "Unable to locate the ""sName"" button !", 64
Else
oBtn.oIA.accDoDefaultAction oBtn.hwnd
ClipboardExec = True
End If
End Function

Private Function Find_IAO(ByVal hwnd&, sName$) As AccObject
Dim oParent As IAccessible
Set oParent = IA_Object(hwnd)
If oParent Is Nothing Then
Set Find_IAO.oIA = Nothing
Else
Find_IAO = Find_IAO_Child(oParent, sName)
End If
End Function

Private Function IA_Object(ByVal hwnd&) As IAccessible
' Define the GUID for the IAccessible object
Const IAccessIID = "{618736E0-3C3D-11CF-810C-00AA00389B71}"
Dim ID As GUID, Ret As Long, oIA As IAccessible
Ret = IIDFromString(StrConv(IAccessIID, vbUnicode), ID)
' Retrieve the IAccessible object for the form
Ret = AccessibleObjectFromWindow(hwnd, 0, ID, oIA)
Set IA_Object = oIA
End Function

' Recursively looking for a child with specified
' accName and accRole in the accessibility tree
Private Function Find_IAO_Child(oParent As IAccessible, sName$) As AccObject
Dim wCount&, Result&, i%, wKids(), oChild As IAccessible
Find_IAO_Child.hwnd = 0
wCount = oParent.accChildCount
If wCount 0 Then Set Find_IAO_Child.oIA Nothing: Exit Function
ReDim wKids(wCount - 1)
If AccessibleChildren(oParent, 0, wCount, wKids(0), Result) Then
MsgBox "Error retrieving accessible children !", 64
Set Find_IAO_Child.oIA = Nothing
Exit Function
End If
On Error Resume Next
For i = 0 To Result - 1
If IsObject(wKids(i)) Then
If StrComp(wKids(i).accName, sName) 0 And wKids(i).accRole &H2B Then
Set Find_IAO_Child.oIA = wKids(i)
Exit For
Else
Set oChild = wKids(i)
Find_IAO_Child = Find_IAO_Child(oChild, sName)
If Not Find_IAO_Child.oIA Is Nothing Then Exit For
End If
Else
If StrComp(oParent.accName(wKids(i)), sName) = 0 _
  And oParent.accRole(wKids(i)) = &H2B Then
Set Find_IAO_Child.oIA = oParent
Find_IAO_Child.hwnd = wKids(i)
Exit For
End If
End If
Next i
End Function

Private Function EnumChildProc&(ByVal hwnd&, ByVal lParam&)
EnumChildProc = 1
If InStr(1, WindowText(hwnd), sCaption, 1) Then
If ClassName(hwnd) = sClass Then
hChild = hwnd
EnumChildProc = 0
End If
End If
End Function

Private Function ClassName$(ByVal hwnd&)
Dim Buffer$, Ret&
Buffer = Space(256)
Ret = GetClassName(hwnd, Buffer, Len(Buffer))
ClassName = Left$(Buffer, Ret)
End Function

Private Function WindowText$(ByVal hwnd&)
Dim Buffer$
Buffer = String(256, Chr$(0))
GetWindowText hwnd, Buffer, Len(Buffer)
WindowText = Left$(Buffer, InStr(Buffer, Chr$(0)) - 1)
End Function

Sebartom · Answer

Wow !

C'est pas une simple ligne de code !

Les premiers tests fonctionnent, donc je valide ta solution pour mon programme. 

Un énorme merci !

Vider presse-papiers

2 réponses

Votre réponse

Discussions similaires