extraction sous chaine et ajout dans commentaire

[jpp1961]

Inserer un commentaire si …..

Salut la communauté des exceliens
Je fais encore appel à votre aide et à votre indulgence.
Je suis archi nul en vba et malgré toutes les soutions proposé sur le forum (très intéressantes) je suis incapable de modifier les macros afin de l’adapter à mes besoins.

J’aimerai extraire du résultat d’une formule le texte compris entre deux caractères spécifiques (caractère à définir dans le fichier joint le commentaire est entre parenthèse).

J’ai une plage de cellule de H10 à AP200
Chaque cellule contient une formule dont le résultat est la concatenation de plusieurs cellules d’une autre feuille. Une de ces cellules contient le texte que j’aimerai récupéré .

J’aimerai mettre en commentaire le texte compris entre
Les parenthéses (commentaire). Si il y a déjà un commentaire effacer l'ancien et le remplacer par le nouveau.Si pas de parenthéses pas de commentaires

Le déclencheur pourrai être lancer dés l’ouverture de la feuille ou si la valeur de la cellule B3 change ou par clic sur bouton.

Merci d’avance à tous ceux qui prendront le temps de réfléchir à mon problème

Fichier joint

 

[Guest]

Re : extraction sous chaine et ajout dans commentaire

Bonjour,

Voici une macro qui le fera, mais je te laisse l'installer, il faut bien que tu contribue un peu à ton travail.

Sub Commentaires()
    Dim c As Range    'cellule en cours d'examen
    Dim p1 As Integer, p2 As Integer    'position des parenthèses ouvrante et fermante dans la chaîne de texte
    'permet de savoir si un commentaire existe ou pas (lève une erreur dans ce dernier cas)
    On Error Resume Next
    'Boucler sur toutes les cellules de la plage
    For Each c In Range("H10:AP200")    '
        'trouver les parenthèses ouvrante et fermante
        p1 = InStr(1, c, "("): p2 = InStr(1, c, ")")
        'si les deux existent dans la chaîne
        If p1 > 0 And p2 > 0 Then
            'tenter de changer le text du commentaire
            c.Comment.Characters.Text = Mid(c, p1 + 1, p2 - p1)
            'si une erreur est levée, alors la cellule n'a pas de commentaire, un ajouter un avec le texte
            If Err <> 0 Then c.AddComment Mid(c, p1 + 1, p2 - p1)
            'réinitialiser l'erreur
            Err.Clear
        End If
    Next
End Sub

A+

 

[jpp1961]

Re : extraction sous chaine et ajout dans commentaire

Merci Hasco
Je vais faire de mon mieux pour l'installer
te tiens au courant du résultat et encore un grand merci

 

[jpp1961]

Re : extraction sous chaine et ajout dans commentaire

J'ai un petit beug si des commentaires étaient déjà présent cela ne le remplacer pas j'ai un peu modifié ton code
Dans le commentaire la dernière parenthése apparaissée.
Quand penses-tu?
Pour le visuel j'aimerais que la forme du commentaire soit un cercle avec une image de fond
Connait-tu le code adéquate?

Sub Commentaires()
Dim c As Range 'cellule en cours d'examen
Dim p1 As Integer, p2 As Integer 'position des parenthèses ouvrante et fermante dans la chaîne de texte
'permet de savoir si un commentaire existe ou pas (lève une erreur dans ce dernier cas)
On Error Resume Next

'lignes rajouter pour effacer tous les commentaires
Range("h10:ap200").Select
Selection.ClearComments



'Boucler sur toutes les cellules de la plage
For Each c In Range("H10:AP200") '
'trouver les parenthèses ouvrante et fermante
p1 = InStr(1, c, "("): p2 = InStr(1, c, ")")
'si les deux existent dans la chaîne

If p1 > 0 And p2 > 0 Then
'tenter de changer le text du commentaire
c.Comment.Characters.Text = Mid(c, p1 + 1, p2 - (p1 + 1))
'si une erreur est levée, alors la cellule n'a pas de commentaire, un ajouter un avec le texte
If Err <> 0 Then c.AddComment Mid(c, p1 + 1, p2 - (p1 + 1))
'réinitialiser l'erreur
Err.Clear
End If
Next
'lignes ajoutées pour dimensionner en auto la taille
For Each d In ActiveSheet.Comments
d.Shape.TextFrame.AutoSize = True
d.Shape.DrawingObject.AutoSize = True
d.Shape.OLEFormat.Object.AutoSize = True
Next d

'End Sub

 

[Guest]

Re : extraction sous chaine et ajout dans commentaire

Bonjour,

Quelque chose comme ceci (décommenter la ligne .Fill.userPicture et mettre le chemin du fichier image)

Sub Commentaires()
     Dim c As Range    'cellule en cours d'examen
     Dim p1 As Integer, p2 As Integer
    
     Range("H10:AP200").ClearComments
     For Each c In Range("H10:AP200")
         
         p1 = InStr(1, c, "("): p2 = InStr(1, c, ")")
        
         If p1 > 0 And p2 > 0 Then
              c.AddComment (Mid(c, p1 + 1, p2 - p1 - 1))
              With c.Comment.Shape
                 .DrawingObject.AutoSize = True
                .AutoShapeType = msoShapeOval
                '.Fill.UserPicture= loadpicture("Chemin vers le fichier image")
            End With           
         End If
     Next
 End Sub

A toi de jouer sur les propriétés du Shape à ta guise
A+

 

[jpp1961]

Re : extraction sous chaine et ajout dans commentaire

Super exactement cela
merci à toi