안녕하세요?
vba 배열을 이용한 사진대지 입니다.
사용법은 아주 간단합니다.
사진 삽입하기 버튼을 클릭하면 그림삽입 대화상자가 나타나고 해당 대화상자에서
사진을 선택하면 merge셀의 크기에 맞춰 사진이 자동입력됩니다.
물론 추후 사진을 보며 사진설명이나 일시만 입력하면 됩니다.
사진대지 초기화 버튼을 클릭하면 입력된 사진을 삭제해서 초기화 합니다.
이 자료는 KFC님이 주코드를 작성했고 제가 약간의 수정을 한 자료입니다.
KFC님께 감사의 말씀 전합니다.
코드는 아래와 같습니다.
Option Explicit
Private Sub CommandButton1_Click()
Dim jhrng() As Range, Trng As Range
Dim jhBool As Boolean, TBool As Boolean
Dim jhShp As Shape
Dim i As Integer, j As Integer
For Each Trng In ActiveSheet.UsedRange '사진을 담을 범위를 배열에 저장
If Trng.MergeCells And Trng.MergeArea.Rows.Count = 9 And Trng.Address = Trng.MergeArea.Cells(1).Address Then
i = i + 1
ReDim Preserve jhrng(1 To i)
Set jhrng(i) = Trng.MergeArea
End If
Next Trng
For j = 1 To UBound(jhrng)
For Each jhShp In ActiveSheet.Shapes '개체를 돌면서 해당 영역에 사진이 있는지 확인
If Intersect(jhrng(j), Range(jhShp.TopLeftCell, jhShp.BottomRightCell)) Is Nothing Then
TBool = True
Else
TBool = False
Exit For
End If
Next jhShp
If TBool Then '모든 개체를 확인해서 해당영역에 사진이 없다면
jhBool = Application.Dialogs(xlDialogInsertPicture).Show
If jhBool Then
With Selection
.Left = jhrng(j).Left + 5
.Top = jhrng(j).Top + 5
.Width = jhrng(j).Width - 8
.Height = jhrng(j).Height - 8
End With
Selection.ShapeRange.Height = 255#
Selection.ShapeRange.Width = 340.5
Else
Exit Sub '사진을 선택하지 않으면 나가기
End If
End If
Next j
Range("a1").Select
End Sub
Private Sub CommandButton2_Click()
Dim shp As Shape
If MsgBox("모든 그림개체가 사라집니다. 시행하시겠습니까?", vbQuestion + vbYesNo, "재확인") = vbYes Then
For Each shp In ActiveSheet.Shapes
If InStr(shp.Name, "Picture") > 0 Then
shp.Delete
End If
Next
End If
End Sub
자세한 내용은 첨부파일을 참고로...
그럼 또...!
===========================================================================================
첨부파일
090715_사진대지.xlsm
===========================================================================================