Excel 문서에 특정 크기로 자동으로 그림 삽입

Sub InsertPictures()

Dim PicList() As Variant
Dim PicFormat As String
Dim Rng As Range
Dim sShape As Shape
Dim Front As Boolean
Dim Position As Integer

On Error Resume Next
PicList = Application.GetOpenFilename(PicFormat, MultiSelect:=True)

If Application.ActiveCell.Offset(-2, 0).Value = "점검사항" Then
    Front = True
ElseIf Application.ActiveCell.Offset(1, 0).Value = "위치" Then
    Front = False
Else
    MsgBox "Invalid Initial Position"
    Exit Sub
End If

Position = 0
xColIndex = Application.ActiveCell.Column

If IsArray(PicList) Then
    xRowIndex = Application.ActiveCell.Row
    For lLoop = LBound(PicList) To UBound(PicList)

        'Add a re-sized picture
        Set Rng = Range(Cells(xRowIndex, xColIndex + 1), Cells(xRowIndex + 6, xColIndex + 3))
        Set sShape = ActiveSheet.Shapes.AddPicture(PicList(lLoop), msoFalse, msoCTrue, Rng.Left, Rng.Top, Rng.Width, Rng.Height)
        
        'Check position
        If Front = True Then
            Front = False
            xRowIndex = xRowIndex + 8

        ElseIf Front = False Then
            If Cells(xRowIndex, xColIndex).Offset(4, 0).Value = "점검사항" Then
                xRowIndex = xRowIndex + 12
                Front = True
            Else
                xRowIndex = xRowIndex + 8
            End If
        End If
    Next
End If
End Sub

 

VBA 코드 이용

선택된 셀을 기준으로 선택한 Pictures list 를 전달하여 일정한 위치에 열 이동하여 그림 자동으로 삽입

삽입된 크기는 지정 가능