[vb6.0vba] [vb6.0/vba] vba를 활용한 결재 도장 삽입
하나를하더라도최선을
2023-11-04 20:28
868
0
-
- 첨부파일 : 새 Microsoft Excel 워크시트_Ans.xlsm (43.9K) - 다운로드
본문
지식인 답변 중 기록에 남겨둘만해서 남겨봅니다.
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 |
댓글목록0