|
▼ponpon さん:
>よくわかってませんが、
>ミスが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
ponponさん 有難うございました。今後ともよろしくお願いいたします。
|
|