XL 2019 gestion du presse papier

[ESCOUGER2022]

Bonjour,
De retour sur ce forum si instructif après quelques années d'interruption!
Je suis en but à un souci concernant l'effacement du presse-papier excel avec excel 2019.
J'ai vu et essayé de nombreuses formules proposées dans ce forum pour effacer le presse-papier, mais malheureusement l'effacement ne s'effectue pas.
J'ai un tableau dans lequel je fais de nombreux copier/ coller ou couper/ coller via des macros VBA. (textes, shapes, pictures...)
Cela fonctionne mais j'ai constaté une dégradation nette du temps de réponse lorsque je travaille longtemps sur ce tableau.
Il arrive même parfois que excel affiche un message m'informant qu'il avait des difficultés avec le presse-papier. (désolé je n'ai pas noté le texte en détail de ce message).
En affichant le presse-papier je constate qu'il ne se vide jamais, et je pense qu'il sature.
Ce que je voudrais serait de vider ce presse-papier (après chacun des "paste" par exemple) ou à des endroits appropriés de mon code.
Mais peut-être n'ai-je pas compris comment fonctionne ce clipboard, ou que je confonde avec le clipboard de windows?
Pour afficher le clipboard je pars du menu accueil, puis clique sur la petite croix "presse-papiers"
Voici ce que j'ai essayé qui n'efface jamais ce presse-papier:

Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Declare Function EmptyClipboard Lib "user32" () As Long
Declare Function CloseClipboard Lib "user32" () As Long
Public Function ClearPressePapier()
With CreateObject("htmlfile").parentWindow.clipboardData.clearData("Text"): End With
End Function
--------------------------------------------------------------------------------------------------------------

Sub EffacerPressePapier()
' effacer le presse papier de excel
Application.CutCopyMode = False
Application.CutCopyMode = True
End Sub
-----------------------------------------------

Sub EffacerPressePapier1() 'appelé par call EffacerPressePapier1
OpenClipboard 0
EmptyClipboard
CloseClipboard
End Sub

------------------------------------------------
Sub viderPressePapier()
'nécéssite d'activer la référence Microsoft Form 2.0 Object Library? OUI Il EST ACTIF
Dim Cible As DataObject
Set Cible = New DataObject
Cible.SetText ""
Cible.PutInClipboard
Set Cible = Nothing
End Sub
----------------------------------------------------------------------------------------------------------------------------------------
Merci d'avance de vos conseils éclairés

 

[Dudu2]

@jurassic pork ,
Non pas plus simple, à peine plus court et piqué aussi sur stackoverflow.com:

 #If VBA7 Then
    Private Declare PtrSafe Function AccessibleChildren Lib "oleacc" (ByVal paccContainer As Office.IAccessible, _
                                                                      ByVal iChildStart As Long, ByVal cChildren As Long, _
                                                                      ByRef rgvarChildren As Any, ByRef pcObtained As Long) As Long
    Private Const myVBA7 As Long = 1
#Else
    Private Declare Function AccessibleChildren Lib "oleacc" (ByVal paccContainer As Office.IAccessible, _
                                                              ByVal iChildStart As Long, ByVal cChildren As Long, _
                                                              ByRef rgvarChildren As Any, ByRef pcObtained As Long) As Long
    Private Const myVBA7 As Long = 0
#End If

Sub ClearOfficeClipboard()
    Dim CmB As Variant
    Dim IsVisible As Boolean
    Dim Arr As Variant
    Dim j As Long
    
    Arr = Array(4, 7, 2, 0) '4 and 2 for 32 bit, 7 and 0 for 64 bit
    Set CmB = Application.CommandBars("Office Clipboard")
    IsVisible = CmB.Visible
    If Not IsVisible Then
        CmB.Visible = True
        DoEvents
    End If

    For j = 1 To Arr(0 + myVBA7)
        AccessibleChildren CmB, Choose(j, 0, 3, 0, 3, 0, 3, 1), 1, CmB, 1
    Next
        
    CmB.accDoDefaultAction CLng(Arr(2 + myVBA7))
    Application.CommandBars("Office Clipboard").Visible = IsVisible
End Sub

 

[ESCOUGER2022]

J'aimerais toujours avoir une réponse à ma question précédente posée à Job75:
Que représente [A1].MergeArea dans le contexte?
Est-ce que MergeArea identifie le presse-papier ?
Est-ce que [A1] est un objet?
Merci d'éclairer ma lanterne...

 

[patricktoulon]

moi j'essaie d'adapter un code qui me sert ailleurs avec le com de l'api mais je n'y arrive pas en plus c'est dommage c'est une fonction générique qui va me chercher n'importe quel onglet ou group ou control dans les group bref dans tout le ruban
une sorte de findwindow mais pour les object du ruban

 

[jurassic pork]

ESCOUGER2022 as-tu essayé nos codes ? parce que je ne pense pas que le code de Job75 s'attaque au presse-papiers Office

 

[patricktoulon]

re
non le code de job75 ne fonctionne pas

ca doit détruire uniquement la copie de la cell

 

[patricktoulon]

J'aimerais toujours avoir une réponse à ma question précédente posée à Job75:
1° Que représente [A1].MergeArea dans le contexte?
2° Est-ce que MergeArea identifie le presse-papier ?
3° Est-ce que [A1] est un objet?
Merci d'éclairer ma lanterne...

réponse
1° représente la cellule A1 avec (ÉVENTUELLEMENT) les cellules qui lui sont fusionnées
2° ben la réponse 1 répond à la 2d c'est non bien évidemment
3° A1 est l’évaluation(evaluate abrégée du contenu des crochets) range par défaut et de plus par le .mergarea est implicitement de type forcé (object ""range"" )

voila

 

[Dudu2]

J'ai fait le tour du monde des solutions et rien trouvé de probant.
Les seuls codes qui fonctionnent sont ceux de @jurassic pork et la version légèrement différente que j'ai récupérée sans y comprendre quoi que ce soit.
Ceci dit j'ai appris qu'il y avait un "Office Clipboard" et ses 24 petits nains ce qui m'a toujours échappé jusque là !

 

[job75]

Hello,

J'aimerais toujours avoir une réponse à ma question précédente posée à Job75:
Que représente [A1].MergeArea dans le contexte?

Pour vider le presse-papier je fais la copie d'une cellule quelconque avec la méthode X.Copy X

Ici sur la cellule A1.

Et j'utilise MergeArea pour le cas où cette cellule est fusionnée, c'est tout.

A+

 

[patricktoulon]

mais en vba 7 sur 32 bits ,il y a aussi un task pane et ses trois rois mages et aussi un clipboard qui chante belle a vita

 

[patricktoulon]

Hello,

Pour vider le presse-papier je fais la copie d'une cellule quelconque avec la méthode X.Copy X

Ici sur la cellule A1.

Et j'utilise MergeArea pour le cas où cette cellule est fusionnée, c'est tout.

A+

re Bonsoir @job75 meileurs veux pour 2025
le but ici est de vider le clipboard pas de remplacer

 

[Dranreb]

Bonsoir.
Je confirme que je n'ai pas constaté de changement du contenu du presse-papier office après exécution de la procédure de @job75. Je m'y attendais un peu vu qu'elle ne me paraissait agir que sur l'état du dispositif d'Excel, assez indépendant* du presse papier, concernant une opération en cours de couper/copier/coller de plage.
* Pas tout à fait indépendant dans la mesure où lors d'une copie de cellule, Excel envoie bien quelque chose dans le presse-papier au cas où, par exemple, un logiciel de dessin voudrait s'en coller une image.

 

[job75]

Oui en effet ma macro ne vide pas le presse-papier Excel.

Pourtant après une opération de copier-coller sur une grande plage, avec images, Excel peut afficher le message "Mémoire insuffisante".

Je constante que cette macro évite le message..

 

[patricktoulon]

perso j'essaie de passer par iaccessible( le com de l'api) mais je n'y arrive pas
j'essaie de faire comme je fait avec mes rubans dans certains contextes

Sub testch()
    Const ROLE_SYSTEM_BUTTONDROPDOWNGRID = &H3A&
    Const ROLE_SYSTEM_TOOLBAR = &H16&
    Dim oRibbon As IAccessible
    Dim oGroup As IAccessible
    Dim oGal As IAccessible
    Dim dropgroup As IAccessible
    
    Set oRibbon = CommandBars("ribbon") ' Ribbon Tool Bar
    ' Groupe
    Set oGroup = FindChildByRoleOrName(oRibbon, "Presse-papiers", ROLE_SYSTEM_TOOLBAR, True)
    DoEvents
    MsgBox Not oGroup Is Nothing
      Set dropgroup = FindChildByRoleOrName(oGroup, "taratatajesaispas", ROLE_SYSTEM_TOOLBAR, True)
 
    ' Gallery : recherche récursive, il ne doit pas y avoir d'autres éléments avec le même label dans le même groupe
    'Set oGal = FindChildByRoleOrName(oGroup, pGallery, ROLE_SYSTEM_BUTTONDROPDOWNGRID, True)
    ' Action par défaut = click
    'Call oGal.accDoDefaultAction(ByVal 0&)

End Sub
' Fonction privée pour rechercher d'un objet accessible à partir de son parent, son role et son nom
Private Function FindChildByRoleOrName(pParent As IAccessible, Optional pChildName As String = "*", Optional pChildRole As String = "*", Optional pRecursif As Boolean = False) As IAccessible
    Dim lName As String, lRole As Long
    Dim oChild As IAccessible
    Const NAVDIR_FIRSTCHILD = &H7&
    Const NAVDIR_NEXT = &H5&
    On Error GoTo gestion_erreurs
    Do
        If oChild Is Nothing Then
            Set oChild = pParent.accNavigate(NAVDIR_FIRSTCHILD, ByVal 0&)
            'Debug.Print oChild.accName(ByVal 0&) & "---" & oChild.accRole(ByVal 0&)
        Else
            Set oChild = oChild.accNavigate(NAVDIR_NEXT, ByVal 0&)
            'Debug.Print oChild.accName(ByVal 0&) & "---" & oChild.accRole(ByVal 0&)
        End If
        If pChildName <> "*" Then lName = oChild.accName(ByVal 0&)
        If pChildRole <> "*" Then lRole = oChild.accRole(ByVal 0&)
        If lRole Like pChildRole And lName Like pChildName Then
            Set FindChildByRoleOrName = oChild
            Exit Do
        End If
        If pRecursif Then
            Set FindChildByRoleOrName = FindChildByRoleOrName(oChild, pChildName, pChildRole, pRecursif)
            If Not FindChildByRoleOrName Is Nothing Then Exit Do
        End If
    Loop
gestion_erreurs:
    If Err.Number <> 0 Then
        Set FindChildByRoleOrName = Nothing
    End If
End Function

mes travaux d'entant etaient basé entre autres sur cette ressource a l’époque

Introduction aux fonctions d'accessibilité

OFFICE : Introduction aux fonctions d'accessibilité

arkham46.developpez.com

 

[Dudu2]

C'est parce que les nains d'Amélie Poulain ont voyagé à travers le monde et on ne sait pas trop où ils sont.

 

[ESCOUGER2022]

OK, je passe un coup de fil à Audrey Tautou!

Pour moi c'est suffisant, car même s'il reste les 24 nains çà fonctionne et les perf de sont pas dégradées.
Merci