Microsoft 365 Moulinette couper contenu cellule coller note

Deremon70

XLDnaute Nouveau
Bonjour,
Je débute en VBA.
Je souhaiterais un programme permettant de couper le contenu d'une cellule pour le passer en "note" de cette meme cellule, tout simplement !

Evidemment, je souhaite obtenir cette macro non pas pour l'opérer sur une seule cellule... Dans ce cas, je ferais l'opération manuellement.
Je dois le faire sur des centaines de cellule.
L'idée est donc d'obtenir une macro qui m'applique cette opération sur un ensemble de cellules sélectionnées.

Merci beaucoup !
 

Victor21

XLDnaute Barbatruc
Bonjour, Deremon70, Daniel :).

Si, en parlant de "note", vous pensez "commentaire" , essayez :
VB:
Sub AjouteCommentaire()
  Selection.ClearComments
  For Each c In Selection
    c.AddComment CStr(c.Offset(0, 1).Value)
    c.Comment.Shape.TextFrame.AutoSize = True
    c.Comment.Shape.OLEFormat.Object.Font.Size = 8
  Next c
End Sub

Sinon, précisez votre demande :)

Edit : Pour effacer le contenu après l'avoir mis en commentaire :
Code:
Sub AjouteCommentaire()
  Selection.ClearComments
  For Each c In Selection
    c.AddComment CStr(c.Value)
    c.Comment.Shape.TextFrame.AutoSize = True
    c.Comment.Shape.OLEFormat.Object.Font.Size = 8
    c.ClearContents
  Next c
End Sub
 
Dernière édition:

Paf

XLDnaute Barbatruc
Bonjour Deremon70, danielco, Victor21,

Une autre version qui comme celle de Victor21 interprète "note" comme "commentaire" :
VB:
Sub Commentaires()
 For Each cel In Selection
    With cel
    If .Value <> "" Then
        If .Comment Is Nothing Then
            .AddComment
            .Comment.Text Text:=.Value
        Else
            .Comment.Text Text:=.Comment.Text & Chr(10) & .Value
        End If
    End If
    End With
 Next
 Selection.ClearContents
End Sub

s'il n'y a pas de données dans la cellule => pas de commentaire
s'il y a déjà un commentaire => ajout du nouveau commentaire

A+
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 912
Membres
101 837
dernier inscrit
Ugo