How to Get an Image from my Subfolder and Display it in a Shapes|VBA & Macros|Excel Forum|My Online Training Hub

Hi Velouria Nice to meet you.
First I say thank you for your code; Nor will I certainly make good use of it.

But in spite of everything it doesn't work as my project is written like this:

Sub EsportaFoglio() On Error GoTo 1 Dim NomeFoglio As String Dim CurFolder, DestFolder, DestFile Dim Shp As Shape Dim SH As Foglio1 Dim idomanda As Integer Application.ScreenUpdating = False 'Qui Si Prende Il Nome Da Dare Al File Appena Creato NomeFoglio = Range("B2").Value & "" 'Funzione Identificativa Del Percorso Di Salvataggio Del File Appena Creato CurFolder = ActiveWorkbook.Path DestFolder = CurFolder & "\Allegati\" DestFile = DestFolder & NomeFoglio & ".xlsx" 'Qui Si Verifica Che Il File Che Si Vuole Creare Non Sia Già Disponibile If Dir(DestFolder, vbDirectory) = "" Then idomanda = MsgBox("Occorre Creare La Sottocartella Denominata Allegati", vbYesNo, "By A.Maurizio - Attenzione !") If idomanda = vbYes Then Exit Sub Else End If End If 'Qui Si Avverte Che Il File Di Excel Esiste Già - Pertanto Se Si Risponde Con Il Tasto ( Si ) _ Il File Esistente Verrebbe Sostituito If Dir(DestFile) <> "" Then idomanda = MsgBox("Esiste Già !!!!", vbYesNo, "By A.Maurizio - Attenzione !") If idomanda = vbYes Then Kill DestFile Else Exit Sub End If End If 'Application.ScreenUpdating = False 'Qui Si Prende Solo Una determinata Area Del Foglio Originale Con i suoi Dati - E Lo Si _ Trasporta Nel Nuovo Foglio Appena Creato Set range1 = Range("A6:L21") Set newbook = Workbooks.Add range1.Copy Range("A1").PasteSpecial Paste:=xlPasteValues 'Con Questo Codice Si Adattano Le Celle Che Hanno Un Dato All'oro Interno Più lungo _ Della cella stessa, in Modo da Poter Visualizzare Il tutto. Range("A6").Select Columns("A:L").ColumnWidth = 16 Range("A1").Select ActiveSheet.Shapes("Rettangolo 2").Fill.UserPicture ActiveWorkbook.Path & "\Immagini_Di_Appoggio\Topolino" & ".jpg" 'Questo Codice Preleva I Dati dalle Varie Funzioni E Li Salva per Creare Il Foglio Di Excel Da Noi Desiderato. ActiveWorkbook.SaveAs Filename:=DestFile, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False 'Questo codice Fa In Modo Che Il Foglio Di excel Appena Creato Venga Subito Salvato Nella Nostra _ Sottocartella Senza Essere Aperto. ActiveWindow.Close 'Application.Quit 'Application.ScreenUpdating = True 1: 'Call AddDonutShape End Sub

Therefore it is true that the Sheet is created and placed in my sub-folder (Attachments)
But only:
1) Not only does the scapes already positioned on base sheet 1 not transport me to the new sheet
2) But if I also put your code before Copy and PasteSpecial,
If I send everything, a sheet is opened with no data and no shapes inserted.
3) And finally the new file is not saved in the folder
That's all
I guarantee you that I have tried to do everything, but there has been no way to do differently to what you see, if you try my project!.
Thanks for everything however you are fantastic
Hello from A.Maurizio
(P.S) I am attaching test files

Hi Velouria, I congratulate you on your program; Even if it is known that it does not differ much from what I had done up to now.
But I tried your program
And I must say that it is true that now everything seems to be normal; Including Image.
What I could notice is that the new excel file is not saved in the Subfolder (\ Attachments \)!
But the file is simply created and then automatically opened.
At this point what should I do in your opinion
to automatically save the Whole as it is.
I await your clarifications on the matter
In the meantime I offer you my sincere thanks from A.Maurizio