|
dew님 도와주셔서 정말 감사합니다.
아래의 도형이 새로 생기는 vba에 하이퍼 링크를 고정 시킬순없는지해서요
새로생긴 도형에 하이퍼링크를 고정하고 지웟다 다시 생성된 도형에도 하이퍼링크가 걸렸으면 합니다ㅠㅠㅠㅠ
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 |
|