|
よくわかってませんが、
ミスが2カ所ほどあるようですが、訂正すると
ちゃんと引かれているようですが・・・・
Option Explicit
Sub Sen()
Dim Cel As Range, Ans As Variant
For Each Cel In Range("D5:U5")
If Cel.Value <> "" Then
Ans = Application.Match(Cel.Value, Rows(14), 0)
If Not IsError(Ans) Then
Call bobo(Cel, Cells(14, Ans))
End If
End If
Next
End Sub
Sub bobo(Cel As Range, RG As Range)
Dim SttL As Double, SttT As Double
Dim EndL As Double, EndT As Double
SttL = Cel.Left + Cel.Width / 2
SttT = Cel.Offset(1).Top
EndL = RG.Left + RG.Width / 2
EndT = RG.Top
With ActiveSheet.Shapes.AddLine(SttL, SttT, EndL, EndT)
.Line.EndArrowheadStyle = msoArrowheadTriangle
End With
End Sub
Sub kesu()
ActiveSheet.DrawingObjects.Delete
End Sub
|
|