ridimensionare immagini in office excel

Buonasera, ho il seguente problema.

 

ho un foglio excel in cui devo caricare diverse immagini.jpg

 

C'è un modo per ridimensionare le varie immagini in base a diverse esigenze di altezza e larghezza??

 

ad esempio nella cella A1 devo caricare una immagine di 6x8cm, nella cella A41 una di dimensione 3x4cm etc etc..

 

La posizione delle celle e e le dimensioni sono state scritte a caso solo per rendere l'idea...

 

Eventualmente le immagini posso metterle tutte in un'unica cartella.

 

Grazie a tutti per l'aiuto!

 

Saluti

Antonio

 

 

 

 

Informazioni domanda


Ultimo aggiornamento febbraio 27, 2018 Visualizzazioni 2.687 Si applica a:
Risposta

... 

c'è un errore nel codice o sbaglio qualcosa io??

 

Ciao Antonio,
no e si in entrambi i casi.

No, perché il codice così com'è in generale funziona.

Sì, perché quando si ridimensiona un'immagine, per default sono mantenute le proporzioni originali per evitare che l'immagine ridimensionata venga distorta, quindi fornendo delle dimensioni 'sballate' l'immagine non è ridimensionata o è ridimensionata nei limiti delle proporzioni originali.

Quindi, allego il codice riveduto e che consente alternativamente:
- di aumentare o diminuire la dimensione dell'immagine, mantenendo le proporzioni originali, in questo caso modifica il parametro dFactor come spiegato nel codice; 
- di ridimensionare l'immagine a tuo piacimento, con il rischio che il risultato sia distorto.

A seconda del metodo che deciderai di utilizzare, modifica i parametri e segui le istruzioni nel codice, per qualsiasi chiarimento sono qua.

Un saluto, 
Andrea.

---
Sub InsertPictureAndResize()
Dim ws As Excel.Worksheet
Dim pic As Object
Dim rDestination As Range
Dim sImageFile As String
Dim dAltezza As Double, dLarghezza As Double, dFactor As Double

  '---------- path completo file immagine
  'sImageFile = "C:\Immagini\Fiore.jpg"

  '----------- fattore di ingrandimento, mantenendo le proporzioni
  '----------- < 1 rimpicciolisce, > 1 ingrandisce
  dFactor = 1.5

  '---------- dimensioni immagine a piacere in cm
  dAltezza = 8#
  dLarghezza = 12#

  '---------- foglio e cella destinazione immagine
  Set ws = ThisWorkbook.Sheets("Articoli")
  Set rDestination = ws.Range("C10")

  If (Len(Dir(sImageFile)) > 0) Then
  'Set pic = ws.Pictures.Insert(sImageFile)
    With ws.Pictures.Insert(sImageFile)
      '---------- inserisce immagine nella cella
      .Top = rDestination.Top
      .Left = rDestination.Left

      '---------- e la ridimensiona mantenendo le proporzioni
      '---------- se utilizzo questo metto un apice alle 3 righe seguenti
'      .Width = .Width * dFactor
'      .Height = .Height * dFactor

      '---------- e la ridimensiona con dimensioni a piacere
      '---------- se utilizzo questo metto un apice alle 2 righe precedenti
      .ShapeRange.LockAspectRatio = msoFalse
      .Width = Application.CentimetersToPoints(dLarghezza)
      .Height = Application.CentimetersToPoints(dAltezza)
    End With
  End If
End Sub
---

Andrea

Il problema è stato risolto?

Siamo spiacenti che questo non sia stato d'aiuto.

Fantastico! Grazie per aver scelto questa risposta.

Sei soddisfatto di questa risposta?

Grazie per il tuo commento, ci aiuta a migliorare il sito.

Sei soddisfatto di questa risposta?

Grazie per il tuo commento.