求助，用vb或者vba在excel表中画箭头的代码？

Question

就是用excel表中的插入箭头，不是导入的图片！

Answer 1

Sub Macro1()

    ActiveSheet.Shapes.AddShape(msoShapeRightArrow, 256.5, 252.75, 86.25, 31.5). _

        Select

    Selection.ShapeRange.Line.ForeColor.SchemeColor = 10

    Selection.ShapeRange.Line.Visible = msoTrue

    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10

    Selection.ShapeRange.Fill.Visible = msoTrue

    Selection.ShapeRange.Fill.Solid

End Sub

追问

您好，谢谢您的回答，我引用了你的代码，但是就是画不出来，没有显示，是不是有些控件没有引入啊?

追答

这是excel 的 VBA 代码！
请在 excel 里面用！

追问

哦，原来如此！谢谢

Answer 2

'绘制箭头Sub DrawJianTou() On Error Resume Next Dim P1 As Variant Dim P2 As Variant Dim N As Integer Dim Plist() As Double Dim L() As AcadEntity P1 = ThisDrawing.Utility.GetPoint(, "指定点:") N = 2xNext: P2 = ThisDrawing.Utility.GetPoint(P1, "指定下一点:") ReDim Preserve L(N / 2 - 1) Set L(UBound(L)) = ThisDrawing.ModelSpace.AddLine(P1, P2) '不知道为什么添加的直线的index不是连续。 用thisdrawing.ModelSpace.Item(index) 删除不掉添加的直线，只能把他们添加到一个数值中。 N = N + 2 ReDim Preserve Plist(N - 1) Plist(N - 4) = P1(0): Plist(N - 3) = P1(1): Plist(N - 2) = P2(0): Plist(N - 1) = P2(1) P1 = P2 If Err Then GoTo D Else GoTo xNext End IfD: Dim i As Long For i = 0 To UBound(L) L(i).Delete Next i Dim PL As AcadLWPolyline Set PL = ThisDrawing.ModelSpace.AddLightWeightPolyline(Plist) PL.SetWidth (UBound(Plist) - 1) / 2 - 2, 200, 0 End Sub

Answer 3

插入这种内容可以使用录制宏来做的。
毕竟这些都不是常用的宏命令，没人会去记他的语法，直接录制宏。多录制几个对比下，就能找出代码中哪部分是需要保留的，哪部分是需要自己设置变量的了。