728x90
반응형
지식인 답변 중 기록에 남겨둘만해서 남겨봅니다.
h t t p s : / / k i n . n a v e r . c o m / q n a / d e t a i l . n a v e r ? d 1 i d = 1 & d i r I d = 1 0 2 0 2 0 1 0 1 & d o c I d = 4 5 7 8 4 8 7 7 4
여기서 도형을 순서대로 "수", "우", "미", "양", "가" 로 이름을 지정합니다.
다음으로 B2 셀에 "수", "우", "미", "양", "가"를 입력 후 엔터를 치면 해당하는 칸에 이미지가 삽입됩니다.
기존 삽입된 상태이면 중복 삽입이 되지 않습니다.
"수", "우", "미", "양", "가" 외에 다른 글자 즉 해당하는 이름의 도형이 없으면 작업을 자동 종료합니다.
아래는 VBA 소스코드입니다.
| Option Explicit '// 현재 시트의 셀값이 변경되면 실행되는 프로시저
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Me.[B2].Address Then '// 셀값이 변경된 셀이 A2셀이면
AppSetting False '// 프로시저 값 False 호출
Dim S As Shape, i As Integer '// 앞으로 상용할 변수 선언
'// 현재 신트의 해당 도형이 있으면 종료(중복 삽입 방지)
Set S = shp(Me, Target): If Not S Is Nothing Then GoTo ErrPass
'// 도형이 있는 시트에서 해당하는 도형이 없으면 종료
Set S = shp(Sheet2, Target): If S Is Nothing Then GoTo ErrPass
'// 가져올 도형 카피
S.CopyPicture
'// 입력한 값에 해당하는 위치값을 반환
i = Application.WorksheetFunction.Match(Target, Array("수", "우", "미", "양", "가"), 0)
'// 찿은 셀에 복사한 도형을 붙여넣음
Me.Paste Destination:=[C2].Offset(, i)
'// 붙여넣은 도형에 대해서
With Selection
'// Top 설정(셀의 세로 가운데)
.Top = .TopLeftCell.Top + (.TopLeftCell.Height - .Height) / 2
'// 왼쪽 설정(셀에 가로 가운데)
.Left = .TopLeftCell.Left + (.TopLeftCell.Width - .Width) / 2
'// 도형의 이름을 변경(추후 중복 삽입 방지)
.Name = Target
End With
ErrPass:
'// 입력받은 셀로 복귀
Target.Activate
'// 화면의 변화와 이벤트 활성
AppSetting True
End If
End Sub
'// 지정한 시트에 지정한 이름의 도형을 반환하는 함수
Private Function shp(ByVal S As Worksheet, ByVal Name As String) As Shape
On Error Resume Next
Set shp = S.Shapes(Name)
End Function
'// 스크린 변화와 이벤트 비활성/활성 프로시저
Private Sub AppSetting(ByVal value As Boolean)
Application.ScreenUpdating = value '// 화면의 변화를 value 값으로
Application.EnableEvents = value '// 이벤트 사용여부 활성/비활성
End Sub
|
반응형
댓글