| |
셀에 숫자값을 입력하면 옆에 도형이 나오는 VBA를 만들고 있습니다.
셀안에 1.사원번호를 입력하면 2.옆에 도형이 나오는 VBA를 만들고 있습니다.
마지막으로 사원번호가 지워지면 도형도 사라지게끔 할수없을까요??
아래의 파일에서 조금만 변경하면 가능할거 같습니다ㅠㅠㅠㅠ
내공 500걸었습니다 ㅠㅠ
Private Sub Worksheet_Change(ByVal Target As Range)
Dim StrFile As String
Dim rC As Range, oP As Picture
Dim x, y, w, h
Application.ScreenUpdating = False
If Target.Column = 1 And Target.Row > 1 Then
For Each rC In Target
For Each oP In ActiveSheet.Pictures
If oP.TopLeftCell.Address = rC.Offset(, 1).Address Then oP.Delete
Next
If rC <> "" Then
StrFile = ThisWorkbook.Path & "\사진\" & rC.Value & ".jpg"
If Dir(StrFile) = "" Then
Else
With rC.Offset(, 1)
x = .Left + 1: y = .Top + 1: w = .Width - 2: h = .Height - 2
ActiveSheet.Shapes.AddPicture(StrFile, 1, 1, x, y, w, h).Select
Selection.ShapeRange.LockAspectRatio = msoFalse
.Select
End With
End If
End If
Next
End If
Application.ScreenUpdating = True
Set rC = Nothing: Set oP = Nothing
End Sub
첨부 이미지
==============[whznzl님 글에 대한 답변입니다]==============
아래는 모두 같은 도형을 입력하는 것입니다.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Target.Row < 2 Or Target.Column > 1 Then Exit Sub
Dim StrFile As String
Dim rC As Range, shpX As Shape
Dim x, y, w, h
Application.ScreenUpdating = False
For Each shpX In Me.Shapes
If shpX.TopLeftCell.Address = Target.Offset(, 1).Address Then
shpX.Delete
End If
Next
If Target.Value <> "" Then
' 도형 삽입하는 부분
Set shpX = ActiveSheet.Shapes.AddShape(msoShapeOval, 1, 1, 1, 1)
With Target.Offset(, 1)
x = .Left + 1: y = .Top + 1: w = .Width - 2: h = .Height - 2
End With
shpX.Left = x
shpX.Top = y
shpX.Width = w
shpX.Height = h
End If
Application.ScreenUpdating = True
End Sub
|
|
엑셀에 대한 질문과
답변을 올려주세요. 단, 취지에 맞지 않는 글은 운영자가 삭제합니다.
