Déplacer commentaires sur tout un classeur
Bonjour le forum
Je ne sais plus qui m'a fait cette macro qui fonctionne super bien
Je crois que c'est Theze mais je crois qu'il est en vacances.
Ça déplace les commentaires sur une feuille seulement.
Serait-il possible de les déplacer sur un classeur entier qui va de Janvier 2018 à Décembre 2018?
Et pas seulement à partir de Janvier 2018. Quelque soit le mois où on se trouve.
Merci d'avance pour vos éventuels retours.
Cordialement
Sub DeplacerCommentaires()
ActiveSheet.Unprotect
Application.EnableEvents = False
Dim Cel1 As Range
Dim Cel2 As Range
On Error GoTo Fin
Set Cel1 = Application.InputBox("Cellule d'origine", , , , , , , 8)
Set Cel2 = Application.InputBox("Cellule de distination", , , , , , , 8)
Cel1.Copy
Cel2.PasteSpecial xlPasteComments, xlNone
Cel1.ClearComments
Application.CutCopyMode = False
Fin:
ActiveSheet.Protect
Application.EnableEvents = True
End Sub
Dans la feuille du mois il y a cette macro également
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, [A2:A8]) Is Nothing Then Exit Sub 'Jouer sur [A2:A8] pour la plage des commentaires à déplacer
If Not Target.Comment Is Nothing Then AfficherMasquerDistanceMoisPrecedent 'AfficherMasquerDistanceMoisPrecedent = Nom Macro
End Sub
Cette macro aussi pour les copier dans tout le classeur mais les commentaires existent que sur une feuille (Janvier 2018)
Option Explicit
Sub CopieCommentairesClasseur()
Dim R As Worksheet 'déclare la variable R (onglet de Référence)
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TC As String 'déclare la variable TC (Texte du Commentaire)
Set R = Worksheets("Janvier 2018") 'définit l'onglet de référence R (celui où il y a le commentaire, à adapter)
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
TC = R.Range("A3").Comment.Text 'définit le texte du commentaire TC (génère une erreur si A3 ne contient pas de commentaire)
If Err <> 0 Then 'condition : si une erreur a été générée
MsgBox "il n'y a pas de commentaire ! Action terminée." 'message
Exit Sub 'sort de la procédure
End If 'fin de la condition
MsgBox "commentaire à copier : " & TC
Application.EnableEvents = False
For Each O In Worksheets 'boucle sur tous les onglets O du classseur
If O.Name <> R.Name Then 'condition : si le nom de l'onglet O est différent du nom de l'onget de référence R
R.Range("A3").Copy O.Range("A3")
End If 'fin de le condition
Next O 'prochain onglet de la boucle
Application.EnableEvents = True
End Sub
Bonjour le forum
Personne pour s'y coller?
Merci à vous pour vos éventuels retours
Bonjour,
peut-être qu'un fichier de travail avec tous les cas de figure motiverait les vocations.
En 5 ans tu ne l'as pas remarqué ?
eric
Voilà,
Je voudrais déplacer les commentaires qui se trouvent cellule A3 de tous les mois dans une cellule à désigner.
Une macro existe => Sub DeplacerCommentaires() mais pour un mois.
Est-il possible de la faire executer à partir du mois en cours (exemple juillet 2018) mais réalisé dans tous les mois (c'est à dire pas obligé d'afficher tous les mois)?
Bien évidemment il faudra quand même ouvrir pour voir si c'est bien réalisé
Merci pour vos éventuels retours
Bien cordialement
Bonjour le forum
J'ai réussi enfin à faire cette macro pour déplacer sur un classeur => Sub DeplacerCommentairesClasseur()
Et celle-ci pour une feuille => Sub DeplacerCommentairesFeuille()
J'ai pensé faire mettre un message de ne pas oublier de modifier les commentaires (Cliquez cellule A3 Distance Mois Précédent )
Si on les déplacent cellule A4 par exemple il faut modifier les commentaires (Cliquez cellule A4 Distance Mois Précédent )
Là je ne sais pas comment le faire et où dans les macros.
Dans les 2 macros => Sub DeplacerCommentairesClasseur() et Sub DeplacerCommentairesFeuille()
Quelqu'un aurait-il une idée comment le faire?
Merci pour vos éventuels retours
Cordialement
Voilà
Bonne fin de soirée à tous
Cordialement
Option Explicit
Sub DeplacerCommentairesClasseur() 'Ne pas oublier de modifier les commentaires avant de lancer la macro
Dim Ws As Worksheet, WsActu As Worksheet
Dim Cel1 As Range
Dim Cel2 As Range
Application.EnableEvents = False
Set Cel1 = Application.InputBox("Cellule d'origine", , , , , , , 8)
Set Cel2 = Application.InputBox("Cellule de destination", , , , , , , 8)
Set WsActu = ActiveSheet
Application.ScreenUpdating = False
For Each Ws In Worksheets 'boucle sur tous les onglets Ws du classseur
If Ws.Name <> WsActu.Name Then 'condition : si le nom de l'onglet Ws est différent du nom de l'onget de référence WsActu
If Not Ws.Range(Cel1.Address).Comment Is Nothing Then
Ws.Unprotect
WsActu.Range(Cel1.Address).Copy
Ws.Range(Cel2.Address).PasteSpecial xlPasteComments, xlNone
Ws.Range(Cel1.Address).ClearComments
Ws.Protect
End If 'fin de le condition
End If
Next Ws 'prochain onglet de la boucle
WsActu.Unprotect
WsActu.Range(Cel1.Address).Copy
WsActu.Range(Cel2.Address).PasteSpecial xlPasteComments, xlNone
WsActu.Range(Cel1.Address).ClearComments
WsActu.Protect
Application.CutCopyMode = False
Fin:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub