Centrare immagini in celle Excel

Question

Buongiorno a tutti,

vi spiego il mio quesito:

devo inserire in un foglio Excel immagini precise ossia scelte ed ordinate in precedenza all'interno di alcune celle del foglio stesso.

Le celle di riferimento sono ordinate in verticale, non hanno spazi l'una dall'altra.

L'immagine deve essere allineata al centro della cella, quindi deve avere dei margini dal bordo della stessa.

Ho provato a creare un codice VBA per le prime 3 immagini, ma non riesco a ripeterlo anche per le successive celle. Inoltre devo digitare manualmente il nome dell'immagine su ogni stringa del codice, come faccio ad ovviare a questo spendendo meno tempo?

Sub Centrareimmagini()

With ActiveSheet.Shapes("Immagine 7")

.Top = Range("A2").Top + (Range("A2").Height - .Height) / 2

.Left = Range("A2").Left + (Range("A2").Width - .Width) / 2

End With

With ActiveSheet.Shapes("Immagine 15")

.Top = Range("A3").Top + (Range("A3").Height - .Height) / 2

.Left = Range("A3").Left + (Range("A3").Width - .Width) / 2

End With

With ActiveSheet.Shapes("Immagine 19")

.Top = Range("A4").Top + (Range("A4").Height - .Height) / 2

.Left = Range("A4").Left + (Range("A4").Width - .Width) / 2

End With

End Sub

Vi ringrazio in anticipo,

Edoardo

Answer 1

Ciao Edoardo,

vi spiego il mio quesito:

devo inserire in un foglio Excel immagini precise ossia scelte ed ordinate in precedenza all'interno di alcune celle del foglio stesso.

Le celle di riferimento sono ordinate in verticale, non hanno spazi l'una dall'altra.

L'immagine deve essere allineata al centro della cella, quindi deve avere dei margini dal bordo della stessa.

Ho provato a creare un codice VBA per le prime 3 immagini, ma non riesco a ripeterlo anche per le successive celle. Inoltre devo digitare manualmente il nome dell'immagine su ogni stringa del codice, come faccio ad ovviare a questo spendendo meno tempo?

Sub Centrareimmagini()

With ActiveSheet.Shapes("Immagine 7")

.Top = Range("A2").Top + (Range("A2").Height - .Height) / 2

.Left = Range("A2").Left + (Range("A2").Width - .Width) / 2

End With

With ActiveSheet.Shapes("Immagine 15")

.Top = Range("A3").Top + (Range("A3").Height - .Height) / 2

.Left = Range("A3").Left + (Range("A3").Width - .Width) / 2

End With

With ActiveSheet.Shapes("Immagine 19")

.Top = Range("A4").Top + (Range("A4").Height - .Height) / 2

.Left = Range("A4").Left + (Range("A4").Width - .Width) / 2

End With

End Sub

In alternativa all'ottimo suggerimento di Daniele, forse prova qualcosa del genere:

'========>>

Option Explicit

'-------->>

Public Sub Centrare_Immagini()

Dim SH As Worksheet 

Dim Rng As Range 

Dim Img As Shape 

Set SH = ActiveSheet 

Set Rng = SH.Range("A2") 

For Each Img In ActiveSheet.Shapes 

    If Img.Type = msoPicture Then 

        With Img 

            .LockAspectRatio = msoFalse 

            .Top = Rng.Top + 8 

            .Height = Rng.Height - 16 

            .Left = Rng.Left + 8 

            .Width = Rng.Width - 16 

        End With 

        Set Rng = Rng.Offset(1) 

        End If 

Next Img 

End Sub

'<<========

          [![Immagine](https://learn-attachment.microsoft.com/api/attachments/ecc3d179-3a10-4a58-a516-6e3d3445b642?platform=QnA"https://learn-attachment.microsoft.com/api/attachments/50510cce-38d1-4af6-92c9-1d96623569ff?platform=QnA" rel="ugc nofollow">

Answer 2

Ciao Edoardo,

qui Daniele, bentrovato nella community Microsoft,

Le immagini che nome hanno? Dove le prendi? Sono già presenti nel file? Secondo quale criterio sono ordinate?

Il codice che hai scritto è semplificabile attraverso l'utilizzo di un ciclo for e concatenazione di stringhe:

https://docs.microsoft.com/it-it/dotnet/visual-...

https://docs.microsoft.com/it-it/dotnet/visual-...

Sub Centrareimmagini()
Dim r As Integer: r = 2
For Each img In ActiveSheet.Shapes
    If InStr(img.Name, "Immagine") > 0 Then
        With img
            .Top = Range("A" & r).Top + (Range("A" & r).Height - .Height) / 2
            .Left = Range("A" & r).Left + (Range("A" & r).Width - .Width) / 2
        End With
        r = r + 1
    End If
Next img
End Sub

Dimmi se ti va, ad ogni modo sarebbe utile avere un file di esempio per capire meglio le tue esigenze.