Macro pour copie de commentaire d'une cellule sur word

Bonjour à tous,

Etant débutant dans les macros sous excel, j'aimerai que quelqu'un m'explique quelle macro je dois faire afin de pouvoir copier le commentaire d'une cellule vers Word ou NotePad.

Par avance Merci de votre aide

Cdt

Kifran75

Bonjour,

voici un exemple utilisant Scripting.FileSystemObject

il faut ajouter la référence : Microsoft Scripting Runtime

voir au menu (vba), Outils, Références, et cocher Microsoft Scripting Runtime

Sub ÉcrireFichierTexte()
Dim oFSO As Scripting.FileSystemObject
Dim oFl As Scripting.file
Dim oTxt As Scripting.TextStream
Set FSys = CreateObject("Scripting.FileSystemObject")
Set oTxt = FSys.CreateTextFile("C:\Documents\test1.txt") 'adapter le chemin et fichier
oTxt.WriteLine Range("A1").Comment.Text
End Sub

Bonjour SabV

Merci pour votre réponse rapide !

cela marche très bien, mais j'aurai voulu que cela n'aille pas directement dans le Bloc-notes mais que cela reste en mémoire pour après aller le coller où l'on veut.

De plus j'aimerai que la copie des commentaires se fasse sur la seule la cellule sélectionnée; mais n'importe laquelle.

Encore MERCI de votre aide

Cordialement

Kifran75

Re bonjour

Et si on pouvait ajouter que le copier garde la mise en page (Gras, souligné, saut de ligne, ect...), cela serai super !

Encore Merci

Cordialement

Kifran75

Bonjour,

voici un essaie avec le Presse-papiers, après l'exécution de la macro CopyToClipboard

vous pouvez sélectionner Word ou un autre application et faire un "Coller"

'ajouter la References: Microsoft Forms 2.0 Object Library
'La méthode PutInClipboard remplace le contenu du Presse-papiers par celui au format texte de DataObject.

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
'Clear Entire Clipboard Contents
Sub ClearClipboard()
    OpenClipboard (0&)
    EmptyClipboard
    CloseClipboard
End Sub

Sub CopyToClipboard()
    Dim clipboard As MSForms.DataObject
    Dim commentaire As String
    ClearClipboard
    Set clipboard = New MSForms.DataObject
    clipboard.SetText ActiveCell.Comment.Text
    clipboard.PutInClipboard
End Sub

Bonjour

Désolé de vous déranger un dimanche...

Malheureusement, cela ne fonctionne pas; voici le message en pièce jointe.

De plus, je ne trouve pas la References: Microsoft Forms 2.0 Object Library dans (vba), Outils, Références !

Merci pour votre retour

Et encore désolé pour Dimanche

Cdt

Kifran75

Bonjour,

C'est surement une différence avec xl 2016,

il y a eu un fil à se sujet ici:

https://forum.excel-pratique.com/excel/new-dataobject-et-ref-microsoft-forms-2-0-object-library-t79719.html

si vous ne trouver pas la librairie Microsoft Forms 2.0 Object Library

rechercher le fichier FM20.DLL sous le répertoire C:\WINDOWS\system32

voici le code donné par thev

Dim MSForm As Object
Dim presse_papier As String

    'récupération presse-papier
    Set MSForm = New DataObject
    MSForm.GetFromClipboard
    presse_papier = MSForm.GetText
    Set MSForm = Nothing

    'vidage presse-papier
    Set MSForm = New DataObject
    MSForm.SetText ("")
    MSForm.PutInClipboard
    Set MSForm = Nothing

    'alimentation presse-papier
    Set MSForm = New DataObject
    MSForm.SetText (presse_papier)
    MSForm.PutInClipboard
    Set MSForm = Nothing

Merci pour votre nouvelle réponse !

Malheureusement je ne trouve pas non plus le fichier : FM20.DLL

Je suis dépité et en plus je n'y comprend quasi rien...

Je pense que je vais arrêter de vous solliciter pour ne plus vous embêter surtout un dimanche.

Je vais passer par "Modifier le commentaire" , "copier", ect...

Je vous joint le fichier pour lequel je voulais faire la copie du commentaire de la cellule D sélectionnée au cas où vous trouvez un solution en 5 minutes.

Encore Merci pour votre aide.

Cordialement

Kifran75

pouvez-vous regarder si le fichier FM20.DLL est présent dans le répertoire

C:\Program Files (x86)\Microsoft Office\root\VFS\SystemX86

Non, je n'ai pas ce fichier à l'endroit demandé mais dans celui -ci :

C:\Programmes\Microsoft Office\root\VFS\System

Peut-être parce que c'est le pack office 2016 x64 ?

Cdt

Kifran75

mais dans celui -ci :C:\Programmes\Microsoft Office\root\VFS\System

c'est une bonne nouvelle, vous allez pouvoir ajouter la référence à Microsoft Forms 2.0 Object Library

et réessayé la macro

Bonjour,

On avance...

J'ai bien réussi à installer la librairie Microsoft Forms 2.0 Object Library en suivant votre instruction.

Mais maintenant, voici le message d'erreur que j'obtiens maintenant (pièce jointe)

Encore MERCI de votre aide !

Cordialement

Kifran75

voulez-vous réessayé cette macro "CopyToClipboard"

ps/ il faut copier tous le code suivant dans un module

et sélectionner une cellule contenant un commentaire avant l'exécution de la macro "CopyToClipboard"

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

'Clear Entire Clipboard Contents
Private Sub ClearClipboard()
    OpenClipboard (0&)
    EmptyClipboard
    CloseClipboard
End Sub

Sub CopyToClipboard()
    Dim clipboard As MSForms.DataObject
    Dim commentaire As String
    ClearClipboard
    Set clipboard = New MSForms.DataObject
    clipboard.SetText ActiveCell.Comment.Text
    clipboard.PutInClipboard
End Sub

Bonjour,

Voici en pièce jointe, le message d'erreur

Cdt

Kifran75

Bonjour,

j'espère que celle-ci fonctionnera, c'est mon dernier essai.

Sub Macro1()
Dim MSForm As Object
Dim presse_papier As String

On Error Resume Next
presse_papier = ActiveCell.Comment.Text
If Err.Number <> 0 Then
 MsgBox "la cellule active ne contient pas de commentaire"
 Err.Clear
 End
End If

    'vidage presse-papier
   Set MSForm = New DataObject
    MSForm.SetText ("")
    MSForm.PutInClipboard

    'alimentation presse-papier
    MSForm.SetText (presse_papier)
    MSForm.PutInClipboard
    Set MSForm = Nothing
End Sub

FELICITATIONS !!!

ça fonctionne à merveille.

Mille Mercis

Cdt

Kifran75