셀에 맞게 여러사진 입력 매크로 실행시 사진화질 원본으로 입력하는 방법

안녕하세요.

선태간 여러셀에 사진 입력하는 매크로를 구하여 사용중에 있습니다.

셀에 사진을 입력했을때는 화질이 그대로인데, 파일을 저장하면  사진 화질이 떨어져 있습니다.

원본 사진 화질 그대로 만들수는 없는지 도움을 요청드립니다.

감사합니다.

Sub 선택한여러셀에사진넣기()

Dim intCount As Integer         ' 선택한 셀의 개수를 저장하는 변수
Dim fileNames As Variant        ' 모든 파일을 넣을 배열 변수
Dim i As Long                   ' 반복문에 사용할 변수
Dim c As Range                  ' 그림이 들어갈 셀을 지정할 변수

Application.ScreenUpdating = False  ' 화면 업데이트 (일시)정지

If TypeName(Selection) <> "Range" Then ' 영역이 선택되지 않았다면
MsgBox "영역이 선택되지 않음" ' 오류 메시지 출력
Exit Sub ' 매크로 종료
End If

intCount = Selection.Count ' 선택된 셀의 개수를 변수에 저장

fileNames = Application.GetOpenFilename("Picture Files (*.jp*; *.gif; *.bmp; *.png),*.xls", , _
"그림파일을 선택", MultiSelect:=True) ' 그림 파일을 선택

If TypeName(fileNames) = "Boolean" Then Exit Sub ' 취소 선택 시 매크로 종료

i = 1 ' 선택된 셀에 그림을 삽입하기 위한 변수 초기화

For Each c In Selection ' 선택한 셀마다 반복

If i > UBound(fileNames) Then Exit Sub ' 선택한 셀의 개수가 그림 개수보다 많으면 매크로 종료

' 각 그림 파일 삽입

With ActiveSheet.Shapes.AddPicture(fileNames(i), 1, 1, 1, 1, 100, 100)
.LockAspectRatio = msoFalse ' 가로세로고정비율 해제
.Top = c.Top + 2 ' 그림 위쪽 위치를 현재 셀 위쪽 + 2 위치에
.Left = c.Left + 2 ' 그림 왼쪽 위치를 현재 셀 왼쪽 + 2 위치에
.Height = c.Height - 4 ' 그림 높이를 현재 셀 높이 - 4 크기로
.Width = c.Width - 4 ' 그림 폭을 현재 셀 폭 - 4 크기로
End With

i = i + 1 ' 다음 그림 삽입을 위한 변수 증가

Next c

Application.ScreenUpdating = True

End Sub