![](data:image/svg+xml, %3Csvg xmlns='http://www.w3.org/2000/svg' height='64' class='font-weight-bold' style='font: 600 30.11764705882353px "SegoeUI", Arial' width='64'%3E%3Ccircle fill='hsl(128, 8%, 22%)' cx='32' cy='32' r='32' /%3E%3Ctext x='50%25' y='55%25' dominant-baseline='middle' text-anchor='middle' fill='%23FFF' %3EA%3C/text%3E%3C/svg%3E)
Microsoft 365 e Office | Excel | Per la casa | Windows
Una famiglia di software per fogli di calcolo Microsoft con strumenti per l'analisi, la creazione di grafici e la comunicazione dei dati.
Ciao,
se vuoi prova a vedere questo file (che è il tuo ma convertito in xlsm per poter contenere macro):
Nel modulo 1 del progetto vba della cartella di lavoro è presente una Sub che esegue la procedura di inserimento delle immagini sfruttanto una Function che, una volta indicati nei propri argomenti il percorso del file nel disco fisso, la cella in cui l'immagine deve essere posizionata, opzioni di centraggio o meno immagine e dimensini, riporta l'immagine nel foglio.
Questo il codice presente nel modulo:
'---
Option Explicit
Sub InserisciImmaginiMain()
Const sNomeFoglio As String = "Filiali"
Const sPrimaCella As String = "A5"
Const NumRiquadriPerRiga As Long = 7
Const NumRiquadriPerColonna As Long = 10
Const ColumnsOffset As Long = 3
Const RowsOffset As Long = 9
Const sPercorso As String = "D:\Test\Francobolli2" '<--- da personalizzare
Const sExt As String = ".jpg" '<--- da personalizzare
Dim Wb As Workbook
Dim Ws As Worksheet
Dim Irng As Range
Dim rngDest As Range
Dim i As Long, j As Long
Dim cont1 As Long, cont2 As Long
Dim sNomeFile As String
Dim imgHeigth As Double, imgWidth As Double
Set Wb = ThisWorkbook
Set Ws = Wb.Worksheets(sNomeFoglio)
Set Irng = Ws.Range(sPrimaCella).Resize(, 2)
For i = 1 To NumRiquadriPerColonna
For j = 1 To NumRiquadriPerRiga
Set rngDest = Irng(1 + cont2, 1 + cont1).Resize(, 2)
sNomeFile = rngDest(0, 2).Value
imgHeigth = rngDest.Height * 0.993
imgWidth = rngDest.Width * 0.993
Call InserisciImmagine(sPercorso & sNomeFile & sExt, rngDest, True, True, imgHeigth, imgWidth, True, sNomeFile)
cont1 = cont1 + ColumnsOffset
Next j
cont1 = 0
cont2 = cont2 + RowsOffset
Next i
End Sub
Sub InserisciImmagine(PictureFileFullName As String, _
TargetCell As Range, _
CenterH As Boolean, _
CenterV As Boolean, _
Optional imgHeight As Double = 0, _
Optional imgWidth As Double = 0, _
Optional bNonProporzionare As Boolean = False, _
Optional PictureName As String)
'modificato da https://www.exceltip.com/general-topics-in-vba/insert-pictures-using-vba-in-microsoft-excel.html
'Inserisce un'immagine in corrispondenza della posizione top e left della cella target (TargeCell)
'L'immagine può essere contrata orizzontalmente o verticalmente (CenterH, CenterV)
'Le dimensioni possono essere impostate (imgHeight, imgWidth)
'Se le dimensioni non vengono impostate l'immagine viene caricata con le dimensioni originarie del file
'Se le dimensioni vengono impostate e la variabile booleana bNonProporzionare è True le dimensioni vengono _
applicate senza riproporzionare l'immagine.
'Se la variabile è False viene applicato la dimensione dell'altezza o larghezza a seconda di quale delle _
due dimensioni e maggiore e l'immagine viene riproporzionata per l'altra dimensione
Dim p As Object, t As Double, l As Double, w As Double, H As Double
If Dir(PictureFileFullName) = "" Then
Debug.Print "Non trovato file con percorso: " & PictureFileFullName
Exit Sub
End If
'Inserisce l'immagine
Set p = TargetCell.Parent.Pictures.Insert(PictureFileFullName)
'Dimensiona l'immagine
With p
If imgHeight > 0 And imgWidth > 0 Then
With .ShapeRange(1)
If bNonProporzionare Then
.LockAspectRatio = msoFalse
.Height = imgHeight
.Width = imgWidth
Else
.LockAspectRatio = msoTrue
If .Height >= .Width Then
.Height = imgHeight
Else
.Width = imgWidth
End If
End If
End With
End If
End With
'determina la posizione
With TargetCell
t = .Top
l = .Left
If CenterH Then
w = .Offset(0, 1).Left - .Left
l = l + w / 2 - p.Width / 2
If l < 1 Then l = 1
End If
If CenterV Then
H = .Offset(1, 0).Top - .Top
t = t + H / 2 - p.Height / 2
If t < 1 Then t = 1
End If
End With
'Posizione e nomina l'immagine
With p
If Len(PictureName) > 0 Then
.Name = PictureName
Else
.Name = PictureFileFullName
End If
.Top = t
.Left = l
End With
Set p = Nothing
End Sub
'---
Nel tuo file il nome dell'immagine non presenta l'estensione.
Quindi nella sub InserisciImmaginiMain dovrai personalizzare anche questo parametro (oltre al percorso in cui si trovano le immagini).
Const sPercorso As String = "D:\Test\Francobolli2" '<--- da personalizzare
Const sExt As String = ".jpg" '<--- da personalizzare
Nota che se un'immagine non viene trovata la procedura non si ferma ma nella finestra immediata dell'editor VBA (Ctrl+g) viene inserito un messaggio di errore come questo:
Non trovato file con percorso: D:\Test\Francobolli2.jpg (in questo caso l'errore è dato perché la cella dove dovrebbe esserci il nome è vuota).
Prova a vedere se funziona con la tua situazione reale.
ciao