Vedi il file allegato...
caricare immaginiIn Foglio2 ho creato un elenco di parole (l'area selezionata, nell'immagine) a cui ho assegnato in nome "pippo"; accanto, dalla colonna C verso destra, un elenco di nomi immagigini (che sono quelle che verranno inserite associandole alla parola di colonna A)
invia immaginiPoi in Foglio1, in A2 ho inserito una convalida "da Elenco" e come origine ho impostato "=pippo" (senza virgolette..)
Nel foglio di codice di Foglio1 ho inserito questa macro:
- Codice: Seleziona tutto
Private Sub Worksheet_Change(ByVal Target As Range)
'by Anthony47
Dim I As Long, myPos, PicSh As Worksheet, cPic As Shape, myPic
'
If Target.Address <> "$A$2" Then Exit Sub
'
Set PicSh = Sheets("Foglio2") '<<< Il foglio con l'elenco di nomi e immagini
mPath = "C:\Users\NomeUTENTE\Pictures" '<<< Directory con le foto
'
Application.EnableEvents = False
Range(Range("A3"), Range("A3").End(xlDown)).ClearContents
For Each cPic In ActiveSheet.Shapes
If Left(cPic.Name, 6) = "ZCPIC_" Then cPic.Delete
Next cPic
If Len(Target.Value) = 0 Then GoTo ExitA
myPos = Application.Match(Target.Value, PicSh.Range("pippo"), 0)
For I = 1 To Len(Target.Value)
Cells(I + 2, 1).Value = Mid(Target.Value, I, 1)
myPic = PicSh.Range("pippo").Cells(myPos, 2 + I).Value
If myPic <> "" Then
With Cells(I + 2, 2)
On Error Resume Next
Set cPic = ActiveSheet.Shapes.AddPicture(mPath & "\" & myPic, False, True, .Left + 3, .Top + 3, True, True)
On Error GoTo 0
If Not cPic Is Nothing Then
cPic.Name = "ZCPIC_" & .Address(0, 0)
cPic.LockAspectRatio = msoTrue
cPic.ScaleHeight ((.Height - 6) / cPic.Height), msoTrue
' If cPic.Width > .Width Then cPic.ScaleWidth ((.Width - 6) / cPic.Width), msoFalse
End If
End With
End If
Set cPic = Nothing
Next I
ExitA:
Application.EnableEvents = True
End Sub
Le righe marcate <<< sono da personalizzare: tasto dx sul tab col nome del foglio, scegli Visualizza codice; identifica le righe e adatta le scritte come da tua situazione.
In questo modo inserendo una parola in A2 di Foglio1 verra' spezzettata la parola sulle celle sottostanti, e accanto verranno inserite le immagini elencate su Foglio2, una per ogni lettera.
Le immagini verranno ridimensionate in base all'altezza delle celle; quindi dovrai prima formattare le celle per assegnare l'altezza delle immagini.
Il link del file di esempio:
https://www.dropbox.com/s/fu1vmbims6zxd ... .xlsm?dl=0Ciao