- Codice: Seleziona tutto
Private Sub Inserisci_Immagini()
Dim MyPath, MioFile, UR As Long, I As Long, Percorso As String
Sheets("Foglio1").Range("A1").Select
MyPath = ActiveSheet.Cells(1, 1)
MioFile = "C:\Users\utente\Desktop\Zoom" & "\" & "*.*"
MyName = Dir(MioFile, vbDirectory)
rg = 1
Do While MyName <> ""
If MyName = ".." Then GoTo lab1
rg = rg + 1
lab1: MyName = Dir
ActiveSheet.Cells(rg, 1) = MyName
Application.ScreenUpdating = False
Sheets("Foglio1").Select
Percorso = C:\Users\utente\Desktop\Zoom"
UR = Range("A" & Rows.Count).End(xlUp).Row
For I = 2 To UR
Cells(I,2).Select
ActiveSheet.Pictures.Insert "C:\Users\Desktop\Zoom\ " & Cells(I, 1)
ActiveSheet.Shapes(cells(I,1)).Select
Selection.ShapeRange.ScaleWidth 0.5, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.5, msoFalse, msoScaleFromTopLeft
Next I
Application.ScreenUpdating = True
Loop
End Sub
Grazie a tutti, alla prossima... Nicola