Sub MyMacro()
Dim mypath As String
Dim myfile As String
Dim myrow As Integer
Dim mypic As String
Dim myend As Boolean
Dim myobj As Object
mypath = Sheets("Foglio1").Cells(1, 1) 'riga 1 colonna A
myrow = 1
myend = False
Sheets("Foglio2").Select
Do While myend = False
myrow = myrow + 1
mypic = Sheets("Foglio1").Cells(myrow, 1)
If mypic = "" Then
myend = True
MsgBox ("riga bianca" & vbCrLf & "HO FINITO")
Exit Sub
End If
myfile = mypath & "\" & mypic
If Dir(myfile) = "" Then
myend = True
MsgBox (myfile & vbCrLf & "ERRORE : FILE NON TROVATO")
Exit Sub
End If
InsertPicture myfile, Range("A1"), True, True
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=myfile & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
For Each myobj In ActiveSheet.Pictures
myobj.Delete
Next myobj
Loop
End Sub
Sub InsertPicture(PictureFileName As String, TargetCell As Range, _
CenterH As Boolean, CenterV As Boolean)
' inserts a picture at the top left position of TargetCell
' the picture can be centered horizontally and/or vertically
Dim p As Object, t As Double, l As Double, w As Double, h As Double
If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
If Dir(PictureFileName) = "" Then Exit Sub
' import picture
Set p = ActiveSheet.Pictures.Insert(PictureFileName)
' determine positions
With TargetCell
t = .Top
l = .Left
If CenterH Then
w = .Offset(0, 1).Left - .Left
l = l + w / 2 - p.Width / 2
If l < 1 Then l = 1
End If
If CenterV Then
h = .Offset(1, 0).Top - .Top
t = t + h / 2 - p.Height / 2
If t < 1 Then t = 1
End If
End With
' position picture
With p
.Top = t
.Left = l
End With
Set p = Nothing
End Sub
