Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2019 gestion du presse papier

ESCOUGER2022

XLDnaute Nouveau
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

XLDnaute Barbatruc
@patricktoulon
Oui, ça c'est sûr.
J'ai encore un peu de code à faire pour un de mes "utilisateurs", mais c'est sûr que ce truc UIAutomation a l'air dément dans les possibilités qu'il donne. Dès que j'ai un peu de temps je vais essayer de regarder tous les tutos VBA UIAutomation que je pourrai trouver pour essayer d'y comprendre quelque chose.

@jurassic pork,
Tu as le fichier qui t'a permis d'afficher les infos du Post #55 ?
Comme tu l'as vu au Post #58, je n'arrive pas à faire tourner le code affiché placé dans le fichier joint.
 

Pièces jointes

  • UIA Classeur1.xlsm
    26.5 KB · Affichages: 1

patricktoulon

XLDnaute Barbatruc
bonjour à tous
VB:
'dans le contexte ou la reference à uiautomationclient est tardive (activée dynamiquement)
'on est obligé de créer l'object comme si on avait pas la réference
Sub ClearPressePapiersOffice3()
    Dim maCmdBar As Object, oUIA As Object, oUIAelem As Object, oElem As Object, oCondition As Object, ipClicBtn As Object
    ' Vérifier si la bibliothèque UIAutomationClient est activée
    If Not IsUIAutomationClientActived Then MsgBox "Impossible d'activer la bibliothèque UIAutomationClient.", vbCritical: Exit Sub
    
    On Error Resume Next
    Set maCmdBar = Application.CommandBars("Office Clipboard")
    maCmdBar.Visible = True
    DoEvents: DoEvents
    ' Créer dynamiquement les objets nécessaires
    Set oUIA = CreateObject("UIAutomationClient.CUIAutomation") 'cr&tion de l'object Uiautmation
    Set oUIAelem = oUIA.ElementFromIAccessible(maCmdBar, 0)
    Set oCondition = oUIA.CreatePropertyCondition(oUIA.UIA_NamePropertyId, "Effacer tout")
    Set oElem = oUIAelem.FindFirst(oUIA.TreeScope_Descendants, oCondition) ' chercher l'élément dans les descendants
    Set ipClicBtn = oElem.GetCurrentPattern(oUIA.UIA_InvokePatternId)
    ' Cliquer sur le bouton "Effacer tout"
    ipClicBtn.Invoke
    maCmdBar.Visible = False
    On Error GoTo 0
End Sub
Function IsUIAutomationClientActived()
   'patricktoulon
   'On Error Resume Next
    Dim ref As Object, hasref As Boolean
    For Each ref In ThisWorkbook.VBProject.References
        If ref.Name = "UIAutomationClient" Then hasref = True: IsUIAutomationClientActived = True: Exit Function
    Next ref
    On Error Resume Next
    If Not hasref Then
        #If Win64 Then
            refPath = Environ("SystemRoot") & "\System32\UIAutomationCore.dll"
        #Else
            refPath = Environ("SystemRoot") & "\SysWOW64\UIAutomationCore.dll"
        #End If
        ThisWorkbook.VBProject.References.AddFromFile refPath
    End If
    If Not Err Then IsUIAutomationClientActived = True
    On Error GoTo 0
End Function
cétoo toutoumatiC
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…