Невозможно установить, если инструкция между моим кодом, чтобы сделать его безошибочным

Question

Я написал код для установки изображений рядом с его ссылкой на листе Excel после его загрузки. Он работает плавно, но проблема в том, что каждый раз, когда я запускаю код, он снова загружается и устанавливается там. Поэтому, если я удалю одну картинку, я увижу другую в этом месте. Я надеюсь, что есть решение в выражении if, чтобы, если оно было применено, оно будет опускать загрузку и перейти к следующему циклу, если ячейка уже заполнена. Я не могу это сделать. Если кто-нибудь поможет мне в этом, я буду очень благодарен. Заранее спасибо.

Примечание: ссылки находятся в столбце B и изображения, которые можно найти в столбце C.

Sub SetPics() 

Dim pics As String 
Dim myPic As Picture 
Dim rng As Range 
Dim cel As Range 

Set rng = Range("C2", Range("B2").End(xlDown).Offset(0, 1)) 

    For Each cel In rng 
     pics = cel.Offset(0, -1) 

     Set myPic = ActiveSheet.Pictures.Insert(pics)  
     With myPic 
      .ShapeRange.LockAspectRatio = msoFalse 
      .Width = cel.Width 
      .Height = cel.Height 
      .Top = Rows(cel.Row).Top 
      .Left = Columns(cel.Column).Left 
     End With  
    Next cel 

End Sub 

Answer 1

Вам нужно отсканировать ActiveSheet (старайтесь не использовать это, и заменить его Worksheets("YourSheetName")) для всех фигур.

Для каждой формы найдены, проверить это свойство TopLeftCell.Row, если он равен cel.Row, то текущее изображение уже существует (из предыдущих серий этого кода), и вы не «повторно вставить» изображение.

Код

Sub SetPics() 

Dim pics As String 
Dim myPics As Shape 
Dim PicExists As Boolean 
Dim myPic As Picture 
Dim rng As Range 
Dim cel As Range 

Set rng = Range("C2", Range("B2").End(xlDown).Offset(0, 1)) 

    For Each cel In rng 
     PicExists = False ' reset flag 
     pics = cel.Offset(0, -1) 

     ' loop through all shapes in ActiveSheet 
     For Each myPics In ActiveSheet.Shapes 
      If myPics.TopLeftCell.Row = cel.Row Then ' check if current shape's row equale the current cell's row 
       PicExists = True ' raise flag >> picture exists 
       Exit For 
      End If 
     Next myPics 

     If Not PicExists Then '<-- add new picture only if doesn't exist 
      Set myPic = ActiveSheet.Pictures.Insert(pics) 
      With myPic 
       .ShapeRange.LockAspectRatio = msoFalse 
       .WIDTH = cel.WIDTH 
       .HEIGHT = cel.HEIGHT 
       .Top = Rows(cel.Row).Top 
       .Left = Columns(cel.Column).Left 
      End With 
     End If 
    Next cel 

End Sub