Dim objShape As Shape, rng As Range, strFileName As String Dim i As Long, j As Long, boolFound As Boolean
Application.ScreenUpdating = False
For Each objShape In ActiveSheet.Shapes If objShape.TextFrame2.TextRange.text <> "Кнопка" Then Set rng = Range(objShape.TopLeftCell, objShape.BottomRightCell) boolFound = False strFileName = "" For i = 0 To -1 Step -1 For j = 1 To rng.Columns.Count If rng.Cells(1, j).Offset(i).Value <> "" Then boolFound = True On Error Resume Next strFileName = WorksheetFunction.VLookup(rng.Cells(1, j).Offset(i).Value, Columns("AK:AL"), 2, 0) On Error GoTo 0 Exit For End If Next j If boolFound = True Then Exit For End If Next i If strFileName = "" Then objShape.Fill.Visible = False ElseIf Dir(strFileName) = "" Then objShape.Fill.Visible = False Else objShape.Fill.Visible = True objShape.Fill.UserPicture strFileName End If End If Next objShape
Application.ScreenUpdating = True
End Sub
[/vba]
[vba]
Код
Sub Вставить_рисунки()
Dim objShape As Shape, rng As Range, strFileName As String Dim i As Long, j As Long, boolFound As Boolean
Application.ScreenUpdating = False
For Each objShape In ActiveSheet.Shapes If objShape.TextFrame2.TextRange.text <> "Кнопка" Then Set rng = Range(objShape.TopLeftCell, objShape.BottomRightCell) boolFound = False strFileName = "" For i = 0 To -1 Step -1 For j = 1 To rng.Columns.Count If rng.Cells(1, j).Offset(i).Value <> "" Then boolFound = True On Error Resume Next strFileName = WorksheetFunction.VLookup(rng.Cells(1, j).Offset(i).Value, Columns("AK:AL"), 2, 0) On Error GoTo 0 Exit For End If Next j If boolFound = True Then Exit For End If Next i If strFileName = "" Then objShape.Fill.Visible = False ElseIf Dir(strFileName) = "" Then objShape.Fill.Visible = False Else objShape.Fill.Visible = True objShape.Fill.UserPicture strFileName End If End If Next objShape