Purger le presse-papier

[renoum01]

Bonjour,
Je souhaiterais créer une macro qui purge tout le contenu du presse papier.
Je m'explique:
Création de l'Etat d'Excel:
1) Il faut afficher le contenu du presse papier(Edition\Presse-Papiers Office)
2)Remplir la feuille avec des données bidon
3)copier/coller plusieurs plage de la première feuille sur une seconde feuille
--> Dans le volet Presse-Papier, il y a maintenant plusieurs entrées.
La macro que je veux créer doit être capable de purger toutes les entrées du
presse papier.

Comment faire?

J'ai essayé l'enrgistrement de macro (d'ailleurs merci MS, une belle
invention) mais rien à faire.
--
Marcel

[AV]

| La macro que je veux créer doit être capable de purger toutes les entrées du
| presse papier.

Application.CommandBars("Clipboard").Controls("&Vider le
Presse-Papiers").Execute

AV

[michdenis]

Bonjour AV,

Tester de plusieurs façons,
il doit y avoir un truc, car je ne peux faire fonctionner cette ligne de code
(Excel 2003). J'ai toujours comme réponse : couic... couic ...;-)

...oui, oui, le presse-papier n'est pas vide.
je l'ai même affiché...

Salutations!

"AV" <alainPF...@wanadoo.fr> a écrit dans le message de news: OfptTV%23JGH...@TK2MSFTNGP12.phx.gbl...

[michdenis]

Bonjour Renoum01,

Cette approche fut proposée par Alain Cros

'Déclaration des API dans le haut du module standard
Private Declare Function OpenClipboard Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function CloseClipboard Lib "user32" () As Long

'-----------------------
Sub test()
OpenClipboard 0
EmptyClipboard
CloseClipboard
End Sub
'-----------------------

Salutations!

"renoum01" <marcel...@saint-gobain.NOSPAM.com> a écrit dans le message de news:
918FC2BE-86F5-45C7...@microsoft.com...

[AV]

| Tester de plusieurs façons,
| il doit y avoir un truc, car je ne peux faire fonctionner cette ligne de code
| (Excel 2003). J'ai toujours comme réponse : couic... couic ...;-)

Effectivement il y a un truc...!
Avec XL2000 faut faire afficher la barre d'outil presse papier :

Sub Vide_Press_Pap()
On Error Resume Next 'Si des fois il n'y avait rien à effacer
With Application
.CommandBars("Clipboard").Visible = True

.CommandBars("Clipboard").Controls("&Vider le Presse-Papiers").Execute

.CommandBars("Clipboard").Visible = False
End With
End Sub

Avec XL 2003 ou 97 ça le fait pas du tout !
On va donc conseiller la méthode que tu rappelles

AV

[Michel Pierron]

Bonsoir renoum01;
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é (attention aux retours lignes intempestifs
dûs à Outlook Express):

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

Bon courage;
MP

"renoum01" <marcel...@saint-gobain.NOSPAM.com> a écrit dans le message de
news: 918FC2BE-86F5-45C7...@microsoft.com...