[Macro] Extraire le texte de remplacement d'une image dans une cellule.

[gege25]

Bonjour,
J'essaye en vain d'extraire le texte de remplacement d'une image présente dans une cellule et le copier dans la cellule la ou l'image est présente dans le fichier ci-joint. Il faudrait arriver à le faire dans les colonnes C & F & E du fichier ci- joint. Exemple extraire le texte de remplacement du verre de vin rouge en C3 et copier "Rouge en C3".
Vous auriez une idée de comment faire ? Car en enregistrant une macro, j'arrive pas à obtenir la commande d'extraction!
Merci pour votre aide

 

[kjin]

Re : [Macro] Extraire le texte de remplacement d'une image dans une cellule.

Bonjour,
Dans un module

Sub zzzzzzzzz()
Columns(6).NumberFormat = "@" 'la colonne est au format nombre à l'origine
For Each sh In ActiveSheet.Shapes
    With sh
        Select Case .TopLeftCell.Column
        Case 3, 5, 6
            .TopLeftCell = .AlternativeText
            .Delete
        End Select
    End With
Next
End Sub

A+
kjin

 

[pierrejean]

Re : [Macro] Extraire le texte de remplacement d'une image dans une cellule.

Bonjour gege25

Et bienvenue sur XLD

Sub test()
Application.ScreenUpdating = False
With Sheets("le point")
 For Each sh In .Shapes
   Range(sh.TopLeftCell.Address) = sh.AlternativeText
 Next
End With
Application.ScreenUpdating = True
End Sub

Edit: Bing
Salut kjin

 

[gege25]

Re : [Macro] Extraire le texte de remplacement d'une image dans une cellule.

Merci ! La macro marche nickel ^^

Edit: Si quelqu'un tombe sur le sujet, voila une macro pour supprimer les images

Sub efface()
    Dim img As Object
        
    For Each img In Worksheets(1).Shapes 'ou Worksheets("nom").Shapes
     img.Delete
    Next
    
End Sub