Как я могу реализовать цикл в моем коде и более эффективно обрабатывать ошибки

Question

Я создаю отчет и автоматизировал процедуру захвата и вставки изображений. Это работает, но дольше, чем нужно. Я надеюсь, что кто-то может помочь мне облегчить код путем реализации цикла.

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

Sub AutoFillInImages ()
'DS # = имя файла изображения
'DS # _1 = имя папки под F: \ Merchandising \ Numbers Style \ DS # \ DS # PIC \
'DS # _2 = подпапка под DS # .2 или официальная папка DS #

Dim Pic As Object
Дим шп как форма
Dim rng As Range
Set rng = Range ("A14")

DS1 = rng & "A.jpg"
DS1_1 = левый (DS1, 6) & "00-" и средний (DS1, 4, 3) и "99"
DS1_2 = левый (DS1, 8)

При ошибке GoTo DS2
Установите shp = ActiveSheet.Shapes.AddPicture (Filename: = "F: \ Merchandising \ Numbers's Style \ DS # \ DS # PIC \" _
& DS1_1 & "\" & DS1_2 & "\" _
& DS1, LinkToFile: = msoFalse, _
SaveWithDocument: = msoCTrue, слева: = 340, сверху: = 46, ширина: = - 1, высота: = - 1)
С шп
.Top = rng.Offset (-9, 0) .Top
.Left = rng.Offset (-2, 0) .Left
.LockAspectRatio = msoTrue
Высота = 190
.IncrementTop 5
.IncrementLeft 40
Конец с

DS2:
Set rng = Range ("A27")

DS1 = rng & "A.jpg"
DS1_1 = левый (DS1, 6) & "00-" и средний (DS1, 4, 3) и "99"
DS1_2 = левый (DS1, 8)

При ошибке GoTo DS3
Установите shp = ActiveSheet.Shapes.AddPicture (Имя файла: = "F: \ Merchandising \ Numbers \ Style's \ \ DS # \ DS # PIC \" _
& DS1_1 & "\" & DS1_2 & "\" _
& DS1, LinkToFile: = msoFalse, _
SaveWithDocument: = msoCTrue, слева: = 340, сверху: = 46, ширина: = - 1, высота: = - 1)
С шп
.Top = rng.Offset (-9, 0) .Top
.Left = rng.Offset (-2, 0) .Left
.LockAspectRatio = msoTrue
Высота = 190
.IncrementTop 5
.IncrementLeft 40
Конец

DS3:
Set rng = Range ("A40")

DS1 = rng & "A.jpg"
DS1_1 = левый (DS1, 6) & "00-" и средний (DS1, 4, 3) и "99"
DS1_2 = левый (DS1, 8)

Set shp = ActiveSheet.Shapes.AddPicture (Имя файла: = "F: \ Merchandising \ Numbers's Style \ DS # \ DS # PIC \" _
& DS1_1 & "\" & DS1_2 & "\" _
& DS1, LinkToFile: = msoFalse, _
SaveWithDocument: = msoCTrue, слева: = 340, сверху: = 46, ширина: = - 1, высота: = - 1)
С шп
.Top = rng.Offset (-9, 0) .Top
.Left = rng.Offset (-2, 0) .Left
.LockAspectRatio = msoTrue
Высота = 190
.IncrementTop 5
.IncrementLeft 40
Конец с

End Sub

Этот код работает, он длиннее, чем я знаю. Спасибо за ваше время, глядя на это!

Answer 1

Создайте подпрограмму или функцию, которую вы можете вызывать повторно с другим параметром (Rng). Избегайте использования GoTo. Используйте On Error Resume Next вместо этого, а затем создайте скобку с If Err.Number = 0 Тогда для следующего раздела кода, чтобы избежать его запуска в случае ошибки. Обратите внимание, что обновленный On Error Resume Next сбрасывает объект Err .