Si pensi di volere inserire con una macro un’immagine in una cella definita del foglio di lavoro, in questo caso nell’intervallo E2:I12 (celle unite)
Aprire l’editor VBA e inserire il seguente codice, all’interno della propria Sub o Function, che servirà per selezionare ed inserire l’immagine all’interno del foglio di lavoro
|
1 2 3 4 5 6 7 8 9 10 11 |
'seleziono l'immagine image = Application.GetOpenFilename() 'se annullo la selezione file If image = False Then MsgBox "Operazione annullata" Exit Sub End If 'inserisco l'immagine nella cella ActiveSheet.Pictures.Insert(image).Select |
Controlliamo e, in caso, ridimensioniamo l’immagine caricata:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 |
'recupero le dimensioni della cella di destinazione e i riferimenti per il posizionamento cellaTop = ActiveSheet.Range("E3").Top cellaLeft = ActiveSheet.Range("E3").Left cellaHeight = ActiveSheet.Range("E13").Top - cellaTop cellaWidth = ActiveSheet.Range("J3").Left - cellaLeft 'ridimensiono l'immagine in base alla grandezza della cella di destinazione If Selection.ShapeRange.Height < Selection.ShapeRange.Width Then 'limito la larghezza dell'immagine Selection.ShapeRange.Width = cellaWidth Else 'limito l'altezza dell'immagine Selection.ShapeRange.Height = cellaHeight End If |
Una volta che l’immagine è stata ridimensionata si procede col centrarla all’interno della cella di destinazione:
|
1 2 3 |
'centro l'immagine nella cella Selection.ShapeRange.Top = (cellaHeight - (Selection.ShapeRange.Height)) / 2 + cellaTop Selection.ShapeRange.Left = (cellaWidth - (Selection.ShapeRange.Width)) / 2 + cellaLeft |
Fatto!
Di seguito il codice completo della Sub:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 |
Option Explicit Sub insert_Image() Dim image Dim cellaDestinazione Dim cellaHeight As Long Dim cellaWidth As Long Dim cellaTop As Long Dim cellaLeft As Long 'recupero le dimensioni della cella di destinazione e i riferimenti per il posizionamento cellaTop = ActiveSheet.Range("E3").Top cellaLeft = ActiveSheet.Range("E3").Left cellaHeight = ActiveSheet.Range("E13").Top - cellaTop cellaWidth = ActiveSheet.Range("J3").Left - cellaLeft 'seleziono l'immagine image = Application.GetOpenFilename() 'se annullo la selezione file If image = False Then MsgBox "Operazione annullata" Exit Sub End If 'inserisco l'immagine nella cella ActiveSheet.Pictures.Insert(image).Select 'ridimensiono l'immagine in base alla grandezza della cella di destinazione If Selection.ShapeRange.Height < Selection.ShapeRange.Width Then 'limito la larghezza dell'immagine Selection.ShapeRange.Width = cellaWidth Else 'limito l'altezza dell'immagine Selection.ShapeRange.Height = cellaHeight End If 'centro l'immagine nella cella Selection.ShapeRange.Top = (cellaHeight - (Selection.ShapeRange.Height)) / 2 + cellaTop Selection.ShapeRange.Left = (cellaWidth - (Selection.ShapeRange.Width)) / 2 + cellaLeft End Sub |