В 2003 офисе макрос работал, в 2007-м -- нет.

макрос должен подгружать один несколько различных рисунков на определенный лист, в 2007 подгружает только первый, т.е. цикл не работает как следует.

Sub ПодключениеПодписи()
Dim НадоОткрыть As Boolean, NotSheet As Boolean
Dim Путь As String, Файл As String, Файлы(15) As String, КолФайл As Long
ПутьФайлXLS = ОткрытиеФайла("Выберите отправляемый файл", ThisWorkbook.Path, "Файл типа: ЛС_*.xls)", "*.xls")
If ПутьФайлXLS = "" Then
Exit Sub
End If

Путь = Trim(ThisWorkbook.Sheets("Настройка").Cells(8, 2))
If Путь = "" Then
Путь = ThisWorkbook.Path
End If
If Not ОткрытиеФайлов("Выберите изображение с подписями", Путь, "Файлы картинок", "*.*", Файлы(), КолФайл) Then
Exit Sub
End If

Application.ScreenUpdating = False
Файл = ИмяФайла(ПутьФайлXLS)
НадоОткрыть = True
For Each w In Workbooks
If w.Name = Файл Then
w.Activate
НадоОткрыть = False
Exit For
End If
Next w
If НадоОткрыть Then

'Workbooks.Open (ПутьФайлXLS + "\" + Файл)
Workbooks.Open (ПутьФайлXLS)
End If
NotSheet = True
For Each sh In Worksheets
If sh.Name = "Подписи" Then
sh.Select
NotSheet = False
Exit For
End If
Next sh
If NotSheet Then
MsgBox ("Нет в книге листа 'Подписи' !")
If НадоОткрыть Then ' закроем только открытую
ActiveWorkbook.Close (False)
End If
Exit Sub
End If
For i = 1 To КолФайл
Cells((i - 1) * 67 + 1, 1).Select
ActiveSheet.Pictures.Ins ert(Файлы(i)).Select
Позиция = InStrRev0(Файлы(i), ".")
Тип = LCase(Mid(Файлы(i), Позиция, 4))
If Тип = ".tif" And ThisWorkbook.Sheets("Настройка").Cells(9, 2) = 1 Then
If Selection.ShapeRange.Height < 500 Then ' т.е. реально сжат
Selection.ShapeRange.ScaleHeight 2.08, msoFalse, msoScaleFromTopLeft
End If
End If
Next i



With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.393700787401575)
.RightMargin = Application.InchesToPoints(0.393700787401575)
.TopMargin = Application.InchesToPoints(0.393700787401575)
.BottomMargin = Application.InchesToPoints(0.393700787401575)
.HeaderMargin = Application.InchesToPoints(0.393700787401575)
.FooterMargin = Application.InchesToPoints(0.393700787401575)
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 20
End With
'Возврат = Sheets(1).Name & "!R7C1"
'ActiveSheet.Hyperlinks.Add Anchor:=Cells(1, 1), Address:="", _
SubAddress:=Возврат
'Cells(1, 1) = "_"
'Worksheets(1).Sele ct ' Что-то нумерация листов после сохранения теряется
For i = 1 To 3 ' версия, реестр и подпись
Sheets(i).Protect Password:="ХХХХХХХХХХХХ", DrawingObjects:=True, Contents:=True, Scenarios:=True
Next i
'ActiveWorkbook.Protect Password:="xхcсvvBВНH", Structure:=True, Windows:=False

ActiveWorkbook.Close (True)
ПутьФайлXLS = РазмерПриклеить(ПутьФайлXLS)
Workbooks.Open (ПутьФайлXLS)
Application.ScreenUpdating = True
End Sub

сразу скажу, что в VBA практически не шарю и делал его не я. В АдЫнэсине попроще будет)))

Помогите, пожалуйста!