(VBA) Insérer un commentaire

Bonjour tout le monde,

Je créer ce post car je suis face à un problème sur mon fichier Excel.

Mon fichier Excel est constitué principalement d'un onglet "Suivi Loyer" ou j'ai créer un tableau grâce a power Query qui rassemble plusieurs bases de données.

J'ai créer une Userform avec plusieurs Textbox et ComboBox, pour faire un ajout de un "loyer" dans ma base de donnée situé dans l'onglet "Loyer".

Dans cette Userform j'ai ajouter une TextBox appelé "commentaire".

Ce que je voudrais faire :

Quand je fais un ajout d'un loyer je voudrais que ma TextBox remplisse ma colonne "commentaire" dans l'onglet Loyers, mais qui s'incrémente aussi comme un commentaire dans ma cellule de mon tableau "suivi de loyer".

Il y aurait t'il quelqu'un pour m'aider ?

Ci joint mon fichier Excel.

En espèrent que vous ayez compris ce que je voudrais faire.

Merci d'avance.

Antho

Bonjour,

Un essai ...

Private Sub CommandButton3_Click()
'...
'...
'...
      Ws.Cells(ligne, "H") = Me.TextBox4    ' << ajout ric
   End If
End Sub

NOTE : N'oublie pas de mettre la propriété "Multiline" à True au "Textbox4" (Commentaire) ...

ric

Bonsoir Ric,

Merci pour ta réponse, mais c'est pas exactement ce que je voudrais faire.

Enfaite je voudrais que le commentaire dans l'onglet "Loyers" s'incrémente automatiquement, en tant que commentaire dans l'onglet "suivi loyers".

Merci à toi

Bonjour,

Dans le tableau de l'onglet "Loyers" > il y a 4 lignes sur un mois > donc 4 commentaires possibles ...

Faut-il cumuler ces 4 commentaires dans la "Note" du mois concerné de la feuille "Suivi Loyers" ???

ric

Bonjour Ric,

Alors oui il y a 4 lignes sur le même mois car il y a 4 locataires différents : A;B;C;D.

Mais il ne faut pas cumuler les 4 commentaires, mais faire en fonctions de chaque locataires

Merci

Bonjour,

Si l'on exécute la macro "CopierCommentaires" du "Module1" > ça fonctionne bien > les commentaires sont copiés dans les bonnes cellules de la feuilles "Suivi loyers" ...

Mais maintenant > en cliquant sur le bouton "Actualiser" > les commentaires s'évaporent > la largeur des colonnes change et ainsi que la disposition du texte des "Entêtes" ...

Étant pourri en requête > je n'ai pas de solution à ce phénomène ...

NOTE : Les noms des locataires doivent être unique. Sinon, il faudra avoir une information à évaluer pour avoir l'unicité ...

ric

Bonsoir Ric,

Super tu m'a bien aidé ! j'ai réussi a contourner le phénomène des commentaires qui s'évaporent quand j'actualisé la page.

La macro fonctionne très bien, il y aurait juste une petite chose en plus.

Même quand j'ai aucun commentaire dans mon onglet "Loyer" il y a quand même un commentaire qui s'ajoute, mais du coup qui est vide dans mon tableau.

Est-il possible de contourner le problème et de ne pas ajouter de commentaire quand la colonne "commentaire" est vide ?

Merci

Bonjour,

Bien sûr que c'est possible > il suffit d'ajouter une petite condition ...

Sub RechercheEcriture()

   With Range("Appartements_2").Rows(0)
      Set c = .Find(Range("Loyers[nom_prénom_locataire]").Rows(X), LookIn:=xlValues)
      If Not c Is Nothing Then Col2 = c.Column
      If Col2 = 0 Then GoTo SUITE
   End With

   For Z = 1 To Range("Appartements_2").Rows.Count
      If Range("Loyers[Date]").Rows(X) = Range("Appartements_2[Date]").Rows(Z) _
                 And Range("Loyers[Commentaire]").Rows(X) <> "" Then   ' << correction ric
         Range("Appartements_2").Columns(Col2).Rows(Z).AddComment
         Range("Appartements_2").Columns(Col2).Rows(Z).Comment.Visible = False
         LeTexte = Range("Loyers[Commentaire]").Rows(X)
         Range("Appartements_2").Columns(Col2).Rows(Z).Comment.Text Text:=LeTexte
         Exit For
      End If
   Next Z
SUITE:
End Sub

ric

Génial !!

Merci beaucoup

ric

Bonjour Ric,

Je me permets de revenir sur ce sujet, et de faire appel à toi.

En effet suite au problème rencontré, tu avais réussi à le résoudre, depuis j'ai fait quelques modification sur mon fichier Excel mais la macro ne fonctionne plus

J'ai inversé les colonnes et les lignes (les noms locataires sont maintenant en ligne et les mois de l'année sont en colonnes) et du coup la macro RechercheEcriture ne reconnais plus les mois de l'année. (Qui était en colonnes "A")

Après plusieurs tentative, je n'arrive pas à adapter ta macro.

Si jamais tu as une solution à m'apporter.

Je te remercie d'avance

Antoto659

Bonjour,

Je regarde la chose ...

ric

Bonjour,

Module1 > j'ai fusionné les deux macros ...

Est-ce que cela convient ?

Option Explicit

Dim X As Integer, Z As Integer, Col As Byte, Col2 As Byte, LeTexte As String
Dim c As Range, firstAddress As String
Dim Rw As Integer

Sub CopierCommentaires()

   Application.ScreenUpdating = False
   Col = Range("Appartements_2").Columns.Count
   Range("Appartements_2").ClearComments

   For X = 1 To Range("Loyers").Rows.Count
      Col2 = 0

      For Z = 2 To Col
         If Range("Appartements_2[#Headers]").Columns(Z) = Range("Loyers[Date]").Rows(X) Then
            Col2 = Z
            LeTexte = Range("Loyers[Commentaire]").Rows(X)
            Exit For
         End If
      Next Z

      With Range("Appartements_2[Appartement]")
         Set c = .Find(Range("Loyers[nom_prénom_locataire]").Rows(X), LookAt:=xlPart)
         If Not c Is Nothing Then Rw = c.Row - 2
      End With

      Range("Appartements_2").Columns(Col2).Rows(Rw).AddComment
      Range("Appartements_2").Columns(Col2).Rows(Rw).Comment.Visible = False
      Range("Appartements_2").Columns(Col2).Rows(Rw).Comment.Text Text:=LeTexte
   Next X

SUITE:
End Sub

ric

Ric,

C'est parfait!

Si je peux me le permettre, j'aimerais avoir cette condition en plus ;

Si le commentaire contient rien alors ne pas afficher la bulle commentaire dans la cellule.

J'ai essayé ceci, mais j'ai une erreur

Option Explicit

Dim X As Integer, Z As Integer, Col As Byte, Col2 As Byte, LeTexte As String
Dim c As Range, firstAddress As String
Dim Rw As Integer

Sub CopierCommentaires()

   Application.ScreenUpdating = False
   Col = Range("Appartements_2").Columns.Count
   Range("Appartements_2").ClearComments

   For X = 1 To Range("Loyers").Rows.Count
      Col2 = 0

      For Z = 2 To Col
         If Range("Appartements_2[#Headers]").Columns(Z) = Range("Loyers[Date]").Rows(X) _
                 And Range("Loyers[Commentaire]").Rows(X) <> "" Then ' Anthotho659
            Col2 = Z
            LeTexte = Range("Loyers[Commentaire]").Rows(X)
            Exit For
         End If
      Next Z

      With Range("Appartements_2[Appartement]")
         Set c = .Find(Range("Loyers[nom_prénom_locataire]").Rows(X), LookAt:=xlPart)
         If Not c Is Nothing Then Rw = c.Row - 2
      End With

      Range("Appartements_2").Columns(Col2).Rows(Rw).AddComment
      Range("Appartements_2").Columns(Col2).Rows(Rw).Comment.Visible = False
      Range("Appartements_2").Columns(Col2).Rows(Rw).Comment.Text Text:=LeTexte
   Next X

SUITE:
End Sub

Anthotho659

Bonjour,

Un simple test juste avant l'insertion de la Note ...

Option Explicit

Dim X As Integer, Z As Integer, Col As Byte, Col2 As Byte, LeTexte As String
Dim c As Range, firstAddress As String
Dim Rw As Integer

Sub CopierCommentaires()

Application.ScreenUpdating = False
Col = Range("Appartements_2").Columns.Count
Range("Appartements_2").ClearComments

For X = 1 To Range("Loyers").Rows.Count
Col2 = 0

For Z = 2 To Col
If Range("Appartements_2[#Headers]").Columns(Z) = Range("Loyers[Date]").Rows(X) Then
Col2 = Z
LeTexte = Range("Loyers[Commentaire]").Rows(X)
Exit For
End If
Next Z

If LeTexte <> "" Then '' <<<<<< Ajout d'un test >>>>>>>
With Range("Appartements_2[Appartement]")
Set c = .Find(Range("Loyers[nom_prénom_locataire]").Rows(X), LookAt:=xlPart) ', LookIn:=xlValues)
If Not c Is Nothing Then Rw = c.Row - 2
End With

Range("Appartements_2").Columns(Col2).Rows(Rw).AddComment
Range("Appartements_2").Columns(Col2).Rows(Rw).Comment.Visible = False
Range("Appartements_2").Columns(Col2).Rows(Rw).Comment.Text Text:=LeTexte
End If
Next X

SUITE:
End Sub

ric

Ric,

Génial !

Merci pour être revenu sur le sujet !

Anthotho659