Commentaires obligatoire

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion isa44
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
I

isa44

XLDnaute Occasionnel
Bonjour , je cherche un début de piste en VBA pour rendre obligatoire l'insertion d'un commentaire pour des cellules non vides.

Pour une zone de cellules ("A30:C45") après la saisie de données afficher un message pour obliger l'insertion de commentaire ou au mieux revenir sur la cellule saisie et insérer un commentaire avec le curseur en position prêt à l'inscription du commentaire.

Merci d'avance pour votre aide
 
Trier par date Trier par votes
Re : Commentaires obligatoire

Bonjour,

N'ayant pas de sources, j'ai créé une petite macro à améliorer (messages redondants que je n'arrive pas à éliminer...
VB: 
Dim must_comment As Boolean
Dim range_comment As Variant

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Range("A30:C45"), Target) Is Nothing Or Target.Value = "" Then Exit Sub
MsgBox "Veuillez Ajouter un commentaire"
range_comment = Target.Address
must_comment = True

Target.Select

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If must_comment = True Then

If Range(range_comment).Comment Is Nothing Then
MsgBox "Veuillez insérer un commentaire en cellule " & range_comment & " avant de continuer"
Range(range_comment).Select
Else
must_comment = False
End If

End If

End Sub

EDIT: Merci phlaurent55 et pierrot93, c'est une vraie mine d'or ce site !
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Commentaires obligatoire

Bonjour,


Voir PJ

Code: 
Dim celAvant
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect([B2:B10], Target) Is Nothing And Target.Count = 1 Then
    If Target <> "" Then
      If Target.Comment Is Nothing Then
        Target.AddComment ' Création commentaire
        SendKeys "{UP}+{F2}"
      Else
        SendKeys "{UP}+{F2}"
      End If
      celAvant = Target.Address
    Else
      On Error Resume Next
      Target.Comment.Delete
      celAvant = ""
    End If
  End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If celAvant <> "" Then
    If Range(celAvant).Comment.Text = "" Then
      Range(celAvant).Select
      SendKeys "+{F2}"
    Else
      celAvant = ""
    End If
   End If
End Sub

JB
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Re : Commentaires obligatoire

Super toutes ces possibilités.

Voici ce que j'ai travaillé pour avoir un format sympa :

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

' insère la boite saisie commentaire

If Not Intersect(Target, Range("A30:C45")) Is Nothing Then
If Target = "" Then Target.ClearComments
If Target <> "" Then
    Target.ClearComments
    Target.AddComment
    
    
        Target.Comment.Text Text:=InputBox("Entrez votre commentaire")

    
        Target.Comment.Text Text:=CStr(Now) & Chr(10) & Chr(10) & Target.Comment.Text & Chr(10)
    lg = Len(Target.Comment.Text)
    With Target.Comment.Shape.TextFrame
      .Characters(Start:=1, Length:=lg).Font.Name = "Verdana"
      .Characters(Start:=1, Length:=lg).Font.Size = 10
      .Characters(Start:=1, Length:=lg).Font.Bold = True
      .Characters(Start:=1, Length:=lg).Font.ColorIndex = 1
      .Characters(Start:=lg, Length:=99).Font.ColorIndex = 1
    End With

    With Target.Comment.Shape ' taille du commentaire
    .Width = 120 '
    .Height = 90
    End With


 End If

    
    
End If


 ' couleur de fond commentaires

    k = Range("A30:C45")
      For Each k In ActiveSheet.Comments
        k.Shape.Fill.ForeColor.SchemeColor = 5
        k.Shape.AutoShapeType = msoShapeRoundedRectangle
      Next k

End Sub

Comment assurer le débogage si l'on clic sur le bouton annuler de l'inputbox ? je verrais bien un message "Vous devez obligatoirement insérer un commentaire"
 
Vote positif 0 Vote négatif
Re : Commentaires obligatoire

Re,

voici le code modifié pour obliger la saisie d'un commentaire
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

' insère la boite saisie commentaire

If Not Intersect(Target, Range("A30:C45")) Is Nothing Then
If Target = "" Then Target.ClearComments
If Target <> "" Then
    Target.ClearComments
    Target.AddComment
    
boucle:
   commentaire = InputBox("Entrez votre commentaire")
If commentaire = "" Then GoTo boucle
Target.Comment.Text Text:=commentaire

   
        Target.Comment.Text Text:=CStr(Now) & Chr(10) & Chr(10) & Target.Comment.Text & Chr(10)
    lg = Len(Target.Comment.Text)
    With Target.Comment.Shape.TextFrame
      .Characters(Start:=1, Length:=lg).Font.Name = "Verdana"
      .Characters(Start:=1, Length:=lg).Font.Size = 10
      .Characters(Start:=1, Length:=lg).Font.Bold = True
      .Characters(Start:=1, Length:=lg).Font.ColorIndex = 1
      .Characters(Start:=lg, Length:=99).Font.ColorIndex = 1
    End With

    With Target.Comment.Shape ' taille du commentaire
    .Width = 120 '
    .Height = 90
    End With


 End If

   
   
End If


 ' couleur de fond commentaires

    k = Range("A30:C45")
      For Each k In ActiveSheet.Comments
        k.Shape.Fill.ForeColor.SchemeColor = 5
        k.Shape.AutoShapeType = msoShapeRoundedRectangle
      Next k

End Sub

à+
Philippe
 
Vote positif 0 Vote négatif
Re : Commentaires obligatoire

Très bien Phillippe , j'aimerais avertir par un message box les utilisateurs qu'ils ont obligation de saisir un commentaire. Je n'arrive pas à en insérer un sans tourner en boucle

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

' insère la boite saisie commentaire

If Not Intersect(Target, Range("A30:C45")) Is Nothing Then
If Target = "" Then Target.ClearComments
If Target <> "" Then
    Target.ClearComments
    Target.AddComment
    
boucle:
   commentaire = InputBox("Entrez votre commentaire")
   If commentaire = "" Then MsgBox " attention", vbExclamation + vbOKOnly

If commentaire = "" Then GoTo boucle
Target.Comment.Text Text:=commentaire

   
        Target.Comment.Text Text:=CStr(Now) & Chr(10) & Chr(10) & Target.Comment.Text & Chr(10)
    lg = Len(Target.Comment.Text)
    With Target.Comment.Shape.TextFrame
      .Characters(Start:=1, Length:=lg).Font.Name = "Verdana"
      .Characters(Start:=1, Length:=lg).Font.Size = 10
      .Characters(Start:=1, Length:=lg).Font.Bold = True
      .Characters(Start:=1, Length:=lg).Font.ColorIndex = 1
      .Characters(Start:=lg, Length:=99).Font.ColorIndex = 1
    End With

    With Target.Comment.Shape ' taille du commentaire
    .Width = 120 '
    .Height = 90
    End With


 End If

   
   
End If


 ' couleur de fond commentaires

    k = Range("A30:C45")
      For Each k In ActiveSheet.Comments
        k.Shape.Fill.ForeColor.SchemeColor = 5
        k.Shape.AutoShapeType = msoShapeRoundedRectangle
      Next k

End Sub
 
Vote positif 0 Vote négatif
Re : Commentaires obligatoire Résolu

Bonjour , j'y suis enfin arrivée à avoir mon message de rappel :

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
' insère la boite saisie commentaire

If Not Intersect(Target, Range("A32:C41")) Is Nothing Then
On Error Resume Next
If Target = "" Then Target.ClearComments
If Target <> "" Then
    Target.ClearComments
    Target.AddComment
    
boucle:
   commentaire = InputBox((Now) & Chr(10) & Chr(10) & "Indiquez la cause de l'indisponibilité", "Saisie commentaire ")
If commentaire = "" Then MsgBox "Vous devez saisir obligatoirement un commentaire"
If commentaire = "" Then GoTo boucle
Target.Comment.Text Text:=commentaire

   
        Target.Comment.Text Text:=CStr(Now) & Chr(10) & Chr(10) & Target.Comment.Text & Chr(10)
    lg = Len(Target.Comment.Text)
    With Target.Comment.Shape.TextFrame
      .Characters(Start:=1, Length:=lg).Font.Name = "Verdana"
      .Characters(Start:=1, Length:=lg).Font.Size = 10
      .Characters(Start:=1, Length:=lg).Font.Bold = True
      .Characters(Start:=1, Length:=lg).Font.ColorIndex = 1
      .Characters(Start:=lg, Length:=99).Font.ColorIndex = 1
    End With

    With Target.Comment.Shape ' taille du commentaire
    .Width = 120 '
    .Height = 90
    End With


 End If

   
   
End If


 ' couleur de fond commentaires

    k = Range("A30:C45")
      For Each k In ActiveSheet.Comments
        k.Shape.Fill.ForeColor.SchemeColor = 5
        k.Shape.AutoShapeType = msoShapeRoundedRectangle
      Next k
      Application.EnableEvents = False


Application.ScreenUpdating = True
End Sub

Merci encore à vous tous
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

anthoYS
  • Résolu(e)
XL 2019 Adapter ce code, et améliorer le tableau avec graphique à l'année à y insérer ?
Réponses
4
Affichages
479
sylvanu
sylvanu
M
  • Résolu(e)
XL 2021 Verrouillage de cellules après exécution d'une macro
2
Réponses
23
Affichages
1 K
MATLEA
M
T
  • Question Question
XL 2019 tableau , cellule protégé et ligne vide
Réponses
2
Affichages
262
sylvanu
sylvanu
A
  • Résolu(e)
Microsoft 365 NB.SI sous condition_fusionner deux formules
Réponses
10
Affichages
539
job75
job75
anthoYS
  • Résolu(e)
XL 2019 alimentation quotidienne : gestion/suivi d'un déficit calorique
2 3
Réponses
39
Affichages
2 K
Phil69970
Phil69970
M
  • Résolu(e)
XL 2016 comment créer une Barre de défilement ou faire simplement défiler son texte ?
2
Réponses
25
Affichages
2 K
melltel
M
P
  • Question Question
XL 2019 Bloquer la saisie dans une colonne sous condition
Réponses
1
Affichages
691
sylvanu
sylvanu
O
  • Question Question
Microsoft 365 Excel [VBA]. Erreur d’exécution 424 Objet requis sur une concaténation
Réponses
3
Affichages
820
Oneida
Oneida
Lu76Fer
XLS : Evènements souris 'click' sur la grille & astuces
Réponses
3
Affichages
671
Lu76Fer
Lu76Fer
D
  • Résolu(e)
Microsoft 365 Assistance pour optimisation d'un code VBA qui ne fonctionne pas comme souhaité
2
Réponses
21
Affichages
1 K
desto
D
C
  • Résolu(e)
XL 2021 Listes déroulantes en cascade
Réponses
8
Affichages
1 K
Constantin
C
crackerwood
  • Question Question
XL 2016 Générateur de temps scénario
Réponses
4
Affichages
464
crackerwood
crackerwood
P
  • Question Question
XL 2019 selection d'un plage de cellules sur feuille protégée
Réponses
2
Affichages
492
pat66
P
D
  • Résolu(e)
Microsoft 365 Macro pour rafraîchir les liaisons
Réponses
11
Affichages
827
AtTheOne
AtTheOne
B
  • Question Question
XL 2021 Transfert tableau structuré EXCEL à un endroit précis de WORD
Réponses
8
Affichages
1 K
job75
job75
S
  • Question Question
Microsoft 365 Rendre obligatoire le remplissage d'un commentaire
Réponses
2
Affichages
918
sebastien176
S
jeff1494
  • Question Question
XL 2021 Comment supprimer des noms du gestionnaire de noms dans un classeur
Réponses
7
Affichages
1 K
jeff1494
jeff1494
Y
  • Résolu(e)
XL 2016 Afficher et masquer les lignes en fonction des critères
Réponses
14
Affichages
818
YANNISE
Y
A
  • Question Question
XL 2021 Automatiser la génération de documents Word à partir d’Excel avec VBA
Réponses
12
Affichages
1 K
ali591
A
CGU2022.
  • Résolu(e)
XL 2013 Problème facturation avec les centimes entre résultat excel (formules) et un calcul à la calculatrice.
Réponses
6
Affichages
1 K
CGU2022.
CGU2022.
Retour