GBKEE

回復 1# yenwang
試試看

1. Option Explicit
   
2. Sub Ex()
   
3.    Dim x As Single, y As Single, x1 As Single, y1 As Single
   
4.    Dim S As Shape
   
5.    ActiveSheet.Shapes.SelectAll
   
6.    Selection.Delete
   
7.    Set S = ActiveSheet.Shapes.AddLine(209.4, 160.2, 370.8, 223.2)
   
8.    With S
   
9.         x = .Left
   
10.         y = .Top
    
11.         x1 = x + .Width
    
12.         y1 = y + .Height
    
13.         
    
14.     End With
    
15.     Set S = ActiveSheet.Shapes.AddLine(x, y + 20, x1, y1 + 20) '往下20點新增線條
    
16. End Sub

複製代碼

GBKEE

回復 1# yenwang
試試看

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Sp As Object
   
4.     Dim A(1 To 4), i, b(1 To 4)
   
5.     A(1) = Array([D5].Left, [D5].Top)
   
6.     A(2) = Array([D10].Left, [D10].Top)
   
7.     A(3) = Array([H10].Left, [H10].Top)
   
8.     A(4) = Array([H5].Left, [H5].Top)
   
9.     ActiveSheet.Shapes.SelectAll
   
10.     Selection.Delete
    
11.     For i = 1 To UBound(A)
    
12.         With ActiveSheet.Shapes.AddLine(A(i)(0), A(i)(1), A(IIf(i < UBound(A), i + 1, 1))(0), A(IIf(i < UBound(A), i + 1, 1))(1))
    
13.         b(i) = .Name
    
14.         End With
    
15.     Next
    
16.     Set Sp = ActiveSheet.Shapes.Range(b)
    
17.     With Sp
    
18.         .Fill.Transparency = 0#
    
19.         .Line.Weight = 4.5
    
20.         .Line.ForeColor.SchemeColor = 10
    
21.     End With
    
22.     Stop
    
23.     A(1) = Array(0, 3, 5, 7)
    
24.     For i = 1 To Sp.Count
    
25.         With Sp(i)
    
26.             .Fill.Transparency = 0
    
27.             .Line.Weight = A(1)(i - 1)
    
28.             .Line.ForeColor.SchemeColor = A(1)(i - 1) + 10
    
29.             .Line.BeginArrowheadLength = msoArrowheadLengthMedium
    
30.             .Line.EndArrowheadWidth = msoArrowheadWidthMedium
    
31.             .Line.EndArrowheadStyle = msoArrowheadOval
    
32.         End With
    
33.     Next
    
34. End Sub

複製代碼