Ajout commentaire vba

MikeBelgique

XLDnaute Occasionnel
Bonjour forum, suite migration 2003 vers 2010, je suis confronté à quelques soucis dont le suivant.


une macro sous 2003 (établie grâce à Spitnolan08 et Staple1600) ne fonctionne plus sous 2010

Sub chargt()
Dim i As Integer
Dim MaCel As Range
For i = 1 To Sheets("A").Range("b65500").End(xlUp).Row
Set MaCel = Sheets("A").Cells(i, "B")
If MaCel <> "" Then
Sheets("Feuil3").Range("A" & i).ClearComments
Sheets("Feuil3").Range("A" & i).AddComment
Sheets("Feuil3").Range("A" & i).Comment.Visible = False
Sheets("Feuil3").Range("A" & i).Comment.Text Text:="Mettre une croix si la personne suivante est en ordre" & Chr(10) & MaCel.Value
Else
Sheets("Feuil3").Range("A" & i).ClearComments
End If
Next
For i = 1 To Sheets("b").Range("b65500").End(xlUp).Row
Set MaCel = Sheets("b").Cells(i, "B")
If MaCel <> "" Then
Sheets("Feuil3").Range("f" & i).ClearComments
Sheets("Feuil3").Range("f" & i).AddComment
Sheets("Feuil3").Range("f" & i).Comment.Visible = False
Sheets("Feuil3").Range("f" & i).Comment.Text Text:="Mettre une croix si la personne suivante est en ordre" & Chr(10) & MaCel.Value
Else
Sheets("Feuil3").Range("F" & i).ClearComments
End If

Next
End Sub

lorsque une modif est apporté voici les erreurs rencontrées :

impossibilité car feuille protégé (les cases en question ne le sont pas et une exception était à l'époque stipulé sur la feuille et dans thisworkbook : Private Sub Workbook_Open()
Feuil1.Protect Password:="toto", contents:=True, DrawingObjects:=False, Userinterfaceonly:=True
End Sub

ligne de commande surlignée jaune Sheets("Feuil3").Range("f" & i).AddComment

ensuite :

erreur automation:
l'objet invoqué s'est déconnecté de ses clients

ligne commande surlignée jaune Sheets("Feuil3").Range("f" & i).Comment.Text Text:="Mettre une croix si la personne suivante est en ordre" & Chr(10) & MaCel.Value

le lien du fil de l'époque avec le fichier de l'époque

https://www.excel-downloads.com/threads/donnees-dans-commentaire.78592/


Merci d'avance pour l'aide que vous pourrez m'apporter.
 

Bebere

XLDnaute Barbatruc
Re : Ajout commentaire vba

bonjour MikeBelgique,Gardien de phare
testé sous 2003
teste si le commentaire existe si oui efface le texte et met un nouveau texte
si non ajoute un commentaire et le texte
peut être que cela t'aidera

Code:
Sub chargt()
Dim i As Integer
Dim MaCel As Range
With Sheets("A")
Set rng = .Range("A1:B" & .Range("A65500").End(xlUp).Row)
End With
For Each Cel In rng.Columns("B").Cells
If Cel <> "" Then
With Sheets("Feuil3")
rep = EstComment(.Range("A" & Cel.Row))
If rep = True Then
.Range("A" & Cel.Row).Comment.Text Text:=""
.Range("A" & Cel.Row).Comment.Text Text:="Mettre une croix si la personne suivante est en ordre" & Chr(10) & Cel.Value
Else
.Range("A" & Cel.Row).AddComment
.Range("A" & Cel.Row).Comment.Text Text:="Mettre une croix si la personne suivante est en ordre" & Chr(10) & Cel.Value
End If

End With
End If
Next Cel

'For i = 1 To Sheets("b").Range("b65500").End(xlUp).Row
'Set MaCel = Sheets("b").Cells(i, "B")
'If MaCel <> "" Then
'Sheets("Feuil3").Range("f" & i).ClearComments
'Sheets("Feuil3").Range("f" & i).AddComment
'Sheets("Feuil3").Range("f" & i).Comment.Visible = False
'Sheets("Feuil3").Range("f" & i).Comment.Text Text:="Mettre une croix si la personne suivante est en ordre" & Chr(10) & MaCel.Value
'Else
'Sheets("Feuil3").Range("F" & i).ClearComments
'End If
'
'Next
End Sub

Function EstComment(x As Object) As Boolean
    Dim C As Comment

    Set C = Nothing
    On Error Resume Next
    Set C = x.Comment
    On Error GoTo 0
    If Not C Is Nothing Then EstComment = True

End Function
 

MikeBelgique

XLDnaute Occasionnel
Re : Ajout commentaire vba

Bonsoir Bebere, merci je teste ta solution et te dis quoi.

Gardien le phare, effectivement sur le fichier du boulot (fichier 2003 converti 2010, en attendant la version 2010
32 bit définitive) cela fonctionne sans souci. Le problème susmentionné étant découvert sur mon pc chez moi, et étant sous office 2010 mais version 64 bit , cela pourrait il en être la cause, la version 64 ayant quelques différences. Je vais me renvoyer du boulot au domicile le bon fichier et retester.
 

MikeBelgique

XLDnaute Occasionnel
Re : Ajout commentaire vba

Bebere j'ai testé au boulot et j'ai l'erreur suivante : erreur 91 : variable objet ou variable du bloc with non définie

Else

.Range("A" & Cel.Row).Comment.Text Text:="Mettre une croix si la personne suivante est en ordre" & Chr(10) & Cel.Value
surlignée en jaune.
 

Si...

XLDnaute Barbatruc
Re : Ajout commentaire vba

salut

les codes ci-dessus fonctionnent tels quels (sans autre macro qui peut interférer), un autre exemple dans le Module "Feuil3" (2 macros pour éviter des répétitions)
Code:
Sub chargt()
  Call comm("A", 1) 'feuille "A" colonne A
  Call comm("B", 6) 'feuille "B" colonne B
End Sub
Sub comm(N As String, C As Byte)
  Dim i As Long
  For i = 1 To Sheets(N).Cells(Rows.Count, 2).End(xlUp).Row
     Cells(i, C).ClearComments
     If Sheets(N).Cells(i, "B") <> "" Then
        Cells(i, C).AddComment
        Cells(i, C).Comment.Visible = False
        Cells(i, C).Comment.Text "Mettre une croix si la personne suivante est en ordre" & Chr(10) & Sheets(N).Cells(i, "B")
      End If
    Next
End Sub
 
Dernière édition:

MikeBelgique

XLDnaute Occasionnel
Re : Ajout commentaire vba

Bonjour bebere, gardien de phare, et bonjour si.

Grosse erreur de ma part et oubli de spécifier une donnée supplémentaire dans le code de mon fichier du travail, j'y avais ajouter des lignes de commande pour mettre en majuscule les noms dans les feuilles A et B, ces lignes était ajoutées au code des feuilles A et B et non dans sub chargt et en les désactivant le commentaire apparait bien et le textE est bien présent tant lorsque j'encode des noms dans le tableau des feuilles A et ou B qu'en exécutant la macro sub chargt

ces lignes étaient ajoutées avant les lignes des feuilles A et B et ceci provoquait l'erreur de départ:

'Met en majuscules les cellules ciblées
Dim isect As Range
On Error GoTo 1
Set isect = Application.Intersect(Target, _
Application.Union(Range("B2:B41"), Range("C2:C41")))
If isect Is Nothing Or IsEmpty(Target) Then

End If
' Les cellules modifiées appartenant aux groupes de cellules cible sont mises en majuscules
Dim C As Variant ' C = cellule modifiée
For Each C In isect
C.Value = UCase(C.Value)
Next C


MEA CULPA, désolé de vous avoir fait perdre votre temps sur un manque de vigilance de ma part.

Ce qui m'a induit en erreur c'est qu'au boulot sur le fichier 2003 que l'on m'a convertit en xlsm (mais toujours office 2003 sur l'ordi) , cela fonctionne sans souci.
 
Dernière édition:

Statistiques des forums

Discussions
312 228
Messages
2 086 418
Membres
103 205
dernier inscrit
zch