XL 2016 Remplacer un texte par une image

lÉducSpace

XLDnaute Nouveau
(Re)Bonjour à vous !

J'aimerais savoir s'il était possible de créer sur excel 2016 une base de donnée qui permettrait d'associer un mot à une image.
Si oui, je voudrais savoir comment procéder et comment puis-je concilier un texte word avec ce "traducteur" excel.

Dans l'attente de votre retour, je vous souhaite une excellente journée.
 

job75

XLDnaute Barbatruc
Je comprends que vous voulez remplacer le mot "L'idée" par une image (ampoule).

Le problème c'est de déterminer la position du mot "L'idée" par rapport aux bords gauche et supérieur de la cellule.

Par rapport au bord gauche c'est possible en utilisant une police à chasse fixe comme Consolas.

Par rapport au bord supérieur a priori je ne vois pas mais si c'est possible ce sera compliqué.
 

job75

XLDnaute Barbatruc
En supposant que le texte est toujours sur une seule ligne, en bas de la cellule, voyez cette macro :
VB:
Sub Traduction()
Dim coef#, marge#, i&, ad$, s As Shape, cible$, txt$, L%, j%
coef = 6 'à adapter par tâtonnement
marge = 2 'à adapter par tâtonnement
Application.ScreenUpdating = False
With [A1].CurrentRegion
    For i = 2 To .Rows.Count
        .Cells(i, 5) = .Cells(i, 1)
        ad = .Cells(i, 5).Address
        For Each s In ActiveSheet.Shapes
            If s.TopLeftCell.Address = ad Then s.Delete 'RAZ
        Next s
        ad = .Cells(i, 4).Address
        For Each s In ActiveSheet.Shapes
            If s.TopLeftCell.Address = ad Then
                s.LockAspectRatio = msoTrue 'conserve le rapport hauteur/largeur
                s.Placement = 2 'déplacer sans dimensionner avec les cellules
                Exit For
            End If
        Next s
        If Not s Is Nothing Then
            cible = .Cells(i, 2)
            txt = .Cells(i, 5)
            L = Len(cible)
            For j = 1 To Len(txt)
                If Mid(txt, j, L) = cible Then
                    Set s = s.Duplicate 'copie la Shape
                    s.Width = coef * L + 2 * marge
                    s.Left = .Cells(i, 5).Left - marge + coef * j
1                   s.Top = .Rows(i).Top + .Rows(i).Height - s.Height
                    If s.Top < .Rows(i).Top + 4 Then .Rows(i).RowHeight = .Rows(i).RowHeight + 1: GoTo 1 'sécurité, la hauteur de ligne est ajustée
                End If
            Next j
        End If
    Next i
End With
End Sub
Edit : j'ai modifié la macro pour que la hauteur de ligne soit ajustée si nécessaire.
 

Pièces jointes

  • trad excel(1).xlsm
    444 KB · Affichages: 17
Dernière édition:

lÉducSpace

XLDnaute Nouveau
OMG !!!!!!

C'est exactement ce que je voulais...

Du coup il suffit de rentrer la phrase dans la colone A et cliquer sur "Traduction" ?

C'est tout simplement génial !

Derniere petite question : puis-je alimenter une sorte de Base de donnée de mots et images sans toucher au code?
 

job75

XLDnaute Barbatruc
La macro que j'ai donnée ne précise pas la feuille, il s'agit donc de la feuille active.

Si vous voulez l'appliquer à la feuille nommée "Feuil2" précisez la feuille :
VB:
With Sheets("Feuil2").[A1].CurrentRegion
PS : OMG sur internet ça veut dire quoi ? Oh My God ?
 

Discussions similaires