Adattare immagine a cella excel

Buongiorno a tutti
Con questo ciclo, importo l'immagine su una form e anche su un foglio di lavoro, e din qui tutto bene.
Ors ho l'esigenza di adattare la foto del foglio di lavoro ad una serie di celle unite tra loro.
Qui c'è qualcosa che non va...
Potreste aiutarmi...
Grazie
Allego uno screenshot

Ciao Daniele le celle unite sono un pugno nell'occhio per Excel ed il VBA.

diciamo che per .Top e .Left potrebbe andare bene, perche indicano l'angolo superiore sx della prima cella ma resta il problema di .Height e .Width che sono la larghezza e l'altezza prova ed inserire direttamente dei valori del tipo a caso devi vedere tu la dimensione ed adattare le misure

.Height = 45
.width = 120

ricorda che per inserire i decimali nel VBA si usa il punto, 120.58

Ciao By Sal (8-D

ciao
potresti farlo nel seguente modo

ipotizziamo che tu abbia un range di celle unite B2:C8, pertanto 7 righe e 2 colonne

- ti posizioni nel range (quindi in pratica excel ti segnala B2 nella casella Nome in alto a sinistra.
dopo l'istruzione
With ActiveSheet.Pictures.Insert(mPa......

valorizzi le seguenti variabili

mTop = ActiveCell.Top
mLeft = ActiveCell.Left
mHeight = Range(ActiveCell.Address & ":" & ActiveCell.Offset(6).Address).Height
mWidth = Range(ActiveCell.Address & ":" & ActiveCell.Offset(, 1).Address).Width
(dove 6 e 1 sono rispettivamente le righe(-1) di cui è composto il range unito e le colonne(-1)
e quindi
.Top = mTop
.Left = mLeft
.Width = mWidth
.Height = mHeight

saluti

prima di tutto vi ringrazio per il Vostro aiuto
ma il codice continua a non funzionare in entrambe i casi

l'ho riscritto adottando la soluzione di Dodo:

On Error GoTo RigaErrore
Dim s As String
Dim sPath As String
Dim mtop As Variant
Dim mleft As Variant
Dim mHeight As Variant
Dim mWidth As Variant


s = TextBox3.Text & ".jpg"
sPath = "\\...\AAAAAFOTO\"
With Me.Image46
.Picture = LoadPicture(sPath & s)
End With
Sheets("FP").Select
ActiveSheet.Pictures.Delete
Range("B2").Select

With ActiveSheet.Pictures.Insert(sPath & s).Select
mtop = ActiveCell.Top
mleft = ActiveCell.Left
mHeight = Range(ActiveCell.Address & ":" & ActiveCell.Offset(6).Address).Height
mWidth = Range(ActiveCell.Address & ":" & ActiveCell.Offset(, 1).Address).Width
.Top = mtop
.Left = mleft
.Width = mWidth
.Height = mHeight

End With

Sheets("PP").Select
Exit Sub

RigaErrore:
MsgBox "immagine non trovata" 'Err.Number & vbNewLine & Err.Description
Image46.Picture = LoadPicture("")
Sheets("PP").Select

quando arriva alla riga ".Top = mtop" mi da errore
c'è qualcosa che mi sfugge :)

ciao
non funziona non vuol dire nulla, spiega che accade e sarebbe bene che tu allegassi un esempio del tuo file, senza dati sensibili in quanto vedo che sei all'interno di una uForm. Non puoi pensare che ci ricostruiamo la tua struttura......

Ti posso solo garantire che quanto suggerito inserisce un'immagine in un range di celle unite delle relative dimensioni.

Ora vedo che ha lasciato inalterato il codice suggerito quindi hai un range unito composto da 7 righe e 2 colonne??

Hai preventivamente disunito il range e poi riunito??

saluti

Ciao Dodo buongiorno
ti ringrazio in anticipo per l'interesse...
purtroppo il file che dovrei allegare è grande e contiene anche dati sensibili, perciò mi riesce impossibile allegarlo.

il problema è che avviando la macro mi da questo errore


in questa riga


perciò mi esce dal ciclo

ciao
capisci bene che non sono in grado di capire il perchè senza vedere un file.
Creane uno essenziale compresa lòa Uform dettagliando bene cosa fare.

L'errore 424 sembra dire che manchi l'oggetto del .Top, ma.......

Comunque ti allego un test:
Nella stessa cartella dove copi l'allegato metti una foto chiamata MiaFoto.jpg (o cambia nome nel codice)

saluti

Questo il codice contenuto:

in pratica non adatta la dimensione della foto al range b2:c8

ho anche trascritto il codice per provarlo su un nuovo foglio di lavoro, ma il problema pesiste
sempre dalla riga .Top = mtop in poi

se lascio "On Error GoTo RigaErrore...." attivo
il problema viene baipassato, mi inserisce la foto ma non la adatta,
se tolgo "On Error GoTo RigaErrore..." il codice si blocca alla riga che ti ho indicato in precedenza

spero di essere stato più esplicito :)

Grazie Dodoooooooo
funzionaaaaaa
sei stato gentilissimo e tanto paziente
l'ultimo codice che mi hai passato funziona perfettamente, l'ho solo riadattato e inserito nella Private Sub che già avevo
in pratica questo è il risultato finale:

Private sub ........
On Error GoTo RigaErrore
Dim s As String
Dim mFile As String
Dim nRighe As String
Dim nColonne As String
Dim mtop As Variant
Dim mleft As Variant
Dim mHeight As Variant
Dim mWidth As Variant

s = TextBox3.Text & ".jpg"
mFile = "\\....\AAAAAFOTO\"
With Me.Image46
.Picture = LoadPicture(mFile & s)
End With

s = TextBox3.Text & ".jpg"
mFile = "\\...\AAAAAFOTO\"
nRighe = Range("P1").MergeArea.Rows.Count
nColonne = Range("P1").MergeArea.Columns.Count
Sheets("FP").Select
ActiveSheet.Pictures.Delete
Range("P1").Select
Selection.UnMerge
With ActiveSheet.Pictures.Insert(mFile & s)
.ShapeRange.LockAspectRatio = msoFalse
mtop = ActiveCell.Top
mleft = ActiveCell.Left
mHeight = Range(ActiveCell.Address & ":" & ActiveCell.Offset(10).Address).Height
mWidth = Range(ActiveCell.Address & ":" & ActiveCell.Offset(, 4).Address).Width
.Top = mtop
.Left = mleft
.Width = mWidth
.Height = mHeight
End With
Range(ActiveCell.Address & ":" & ActiveCell.Offset(10, 4).Address).Merge

Sheets("PP").Select
Exit Sub

RigaErrore:
MsgBox "immagine non trovata"
Image46.Picture = LoadPicture("")
Sheets("PP").Select
end sub

Ti ringrazio veramente ;)

Buongiorno a tutti
Confermo che la macro di @dodo47 (ciao Domenico) è perfettamente funzionante.

Forse (e ripeto forse) la adatterei a 6 righe e DUE colonne (attualmente adatta la foto a 6 righe e TRE colonne)

Ciao,
Mario

Marius44, 03/03/2023 11:11:

---

Buongiorno a tutti
Confermo che la macro di @dodo47 (ciao Domenico) è perfettamente funzionante.

Forse (e ripeto forse) la adatterei a 6 righe e DUE colonne (attualmente adatta la foto a 6 righe e TRE colonne)

Ciao,
Mario

---

Si certo Mario....erano numeri buttati a caso....

grazie e un carissimo saluto

E.Daniele

Non sono d'accordo sulla tua gestione errore.
Non è detto che se la macro va in errore sia perchè non ha trovato l'immagine, può capitare anche altro
Ti ripropongo il codice con le modifiche che io applicherei.

Si Dodo
Il mio riferimento all'errore era solo per dire che comunque il problema esisteva e veniva baipassato.
Comunque con la macro che mi hai inviato stamattina funziona tutto alla perfezione.
Ora purtroppo non sono in ufficio e non posso provare le ultime modifiche che mi hai inviato.
Ma ri ringrazio comunque