commentaire!

[MerciD]

Salut à tous.
J'espere que vous allez tous bien.
Mon probleme est le suivant : j'aimerais commenter la colonne b de la feuille1 avec les texts de la colonne b de la feuille2. J'ai une tres longue liste, c'est pourquoi j'aimerais faire cela automatiquement.
Voici un extrait et un bout de code avec une macro qui ne marche pas.
Merci d'avance.
Bonne journee

 

[Papou-net]

Re : commentaire!

Bonjour MrciDS,

Je pense que ton problème est dû à la syntaxe de ta commande AddComment.
Le texte du commentaire doit suivre la commande, précédé d'un espace :
Ex :

Worksheets(1).Range("B" & i).AddComment c.Offset(0, language).Value

ou bien

Worksheets(1).Range("B" & i).AddComment "Fehlercode nicht definiert!"

Espérant t'avoir aidé.

Cordialement.

 

[Guest]

Re : commentaire!

Bonjour,

Vois si cela te convient.

Si tes référence sont unique comme dans l'exemple joint, tu n'as pas besoin de faire une boucle Do....While pour la recherche. La boucle For suffit amplement.

A+

 

[Dull]

Re : commentaire!

Salut MerciD, Papou-net, le Forum

Un essai en pièce jointe si j'ai bien compris

Sub Commentaire()
Dim C As Range, X As Range
For Each C In Sheets("Tabelle1").Range("B2:B34")
Set X = Sheets("Tabelle2").Columns("D").Find(What:=C)
    If Not C Is Nothing Then
        If C = X And C <> "" Then
            With C
                .ClearComments
                .AddComment.Text X.Offset(0, 2).Value
            End With
        End If
    End If
Next C
End Sub

EDITION: Hi Ges🙂

Bonne Journée

 

[jp14]

Re : commentaire!

Bonjour à tous

Ci dessous une procédure

Option Explicit
Sub travdem()
Dim cellule As Range
Dim nomfeuille1 As String
Dim dl1 As Long
Dim lig As Long
Dim data1 As String
' pour boucler sur la colonne 1

dl1 = Sheets("Tabelle2").Cells(Sheets("Tabelle2").Columns(4).Cells.Count, 4).End(xlUp).Row + 1
With Sheets("Tabelle1")

For Each cellule In .Range("b2:b" & .Cells(Columns(2).Cells.Count, 2).End(xlUp).Row)

    If cellule.Value <> "" Then
    lig = chercheligne("Tabelle2", cellule.Value, "d3", "d" & dl1)
       
        If lig > 0 And Sheets("Tabelle2").Range("f" & lig) <> "" Then
        On Error Resume Next
        cellule.ClearComments
        cellule.AddComment
        cellule.Comment.Text Text:= Sheets("Tabelle2").Range("f" & lig)
        cellule.Comment.Visible = False
        'With cellule.Comment.Shape
            '.Width = 130 'Largeur commentaire
            '.Height = 90 'Hauteur
            '.OLEFormat.Object.Font.Size = 14 'Taille du texte
            '.OLEFormat.Object.Interior.ColorIndex = 34 'Couleur de fond
            '.TextFrame.Characters.Font.ColorIndex = 11 'Couleur de la police
            '.TextFrame.Characters.Font.Bold = True 'Ecriture gras
            '.OLEFormat.Object.Font.Name = "Bangle" 'Type de police
        'End With
        End If

    End If
Next cellule
End With
End Sub

Function chercheligne(£feuille As String, £valeur As String, £col1d As String, £col1f As String)
Dim cel As Range
Set cel = Sheets(£feuille).Range(£col1d & ":" & £col1f).Find(What:=£valeur, LookIn:=xlValues, SearchOrder:=xlByRows, LookAt:=xlWhole)
If cel Is Nothing Then
    chercheligne = 0
Else
    chercheligne = cel.Row
End If
End Function

JP

 

[MerciD]

Re : commentaire!

Salut à tous
Je vous remerci infiniment pour votre aide.
c'est vrai que celle de jp4 etait longue mais grace à votre participation, j'ai pu ressoudre le probleme.
Encore merci e bon Weekend