vba ppt简笔画（几种动物）

ning84

谢谢指点，反复学习你的程序。

到现在不会用Drawline，只会用Addline,AddPolyline

1. 
   
2.   Dim Pres As Presentation
   
3.       Set Pres = Application.ActivePresentation
   
4.   Dim Sld As Slide, Shp As Shape, Shps As Shapes
   
5.       Set Shps = Pres.Slides(2).Shapes
   
6.   Dim Arr(1), tmpArr
   
7.   Dim PlArr()
   
8.       ReDim PlArr(UBound(DrawlineArr) - 2)
   
9.       tmpArr = DrawlineArr
   
10.       
    
11. Dim pointsArray(0 To 3) As Variant
    
12.     pointsArray(0) = Array(10, 10) '第一个顶点坐标
    
13.     pointsArray(1) = Array(52, 30) '第一个顶点坐标
    
14.     pointsArray(2) = Array(20, 40) '第二个顶点坐标
    
15.     pointsArray(3) = Array(15, 30) '第三个顶点坐标
    
16.         Shps.AddPolyline pointsArray
    
17. 
    
18.         For ii = Shps.Count To 1 Step -1
    
19.           Set Shp = Shps(ii)
    
20.           Shp.Delete
    
21.         Next ii
    
22.         Stop
    
23.       For ii = 0 To UBound(DrawlineArr) - 2
    
24.              Arr(0) = tmpArr(ii + 1)(0) + 100
    
25.              Arr(1) = tmpArr(ii + 1)(1) + 200
    
26.              PlArr(ii) = Arr
    
27.       Next ii
    
28.       
    
29.       Shps.AddPolyline PlArr
    
30.       Stop
    
31.       
    
32.       
    
33. 
    
34. 
    
35.         For i = 1 To UBound(Arr)
    
36.             For j = 0 To UBound(Arr(i))
    
37.                  Shps.AddLine Arr(i)(j) + 100, i * 1 + 200, Arr(i)(j) + 100 + 0.5, i * 1 + 200 + 0.5
    
38.             Next
    
39.         Next
    
40. 
    
41.         Stop
    
42. 
    
43.         
    
44.         Stop
    
45. End Sub

复制代码