자료실

부자는 돈을 써서 시간을 아끼지만 가난한 사람은 시간을 써서 돈을 아낀다

vb6.0/vba

IT HUB를 찾아주셔서 감사합니다.

vb6.0vba [vb6.0/vba] vba를 활용한 결재 도장 삽입

페이지 정보

profile_image
작성자 하나를하더라도최선을
댓글 0건 조회 2,370회 작성일 23-11-04 20:28

본문

지식인 답변 중 기록에 남겨둘만해서 남겨봅니다. 

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


8d9a1bcf098121f847ad87f0d894ab8b_1699097048_354.png

여기서 도형을 순서대로 "수", "우", "미", "양", "가" 로 이름을 지정합니다.


8d9a1bcf098121f847ad87f0d894ab8b_1699097048_8471.png다음으로 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 StringAs 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


첨부파일

댓글목록

등록된 댓글이 없습니다.