vba ppt简笔画（几种动物）

dongdonggege

这是我去年根据网络的简笔画，自己改造而成的，有鸽子、 小蜜蜂、 小燕子、小鸭子、小鱼、黑猩猩，献丑，请多提宝贵意见。另外，我做了繁花曲线，等有时间，发上来。

代码就不另发了，文件里有。

zorsite

了不起！
那么多数数组你是怎么处理的？

dongdonggege

zorsite 发表于 2018-4-26 23:25
了不起！
那么多数数组你是怎么处理的？

不好意思，今天才上网，没看到。你可以在百度搜索“vba 简笔画”，你可以搜到“用excel vba编程绘制一副简笔画鸽子”，小山羊等。比如这个网址：http://www.jb51.net/office/excel/470636.html，简笔画画小鸽子，
下面有个Excel表，出现数据，第1行26、27，第2行25、27有数据，意思在excel第1行第26列、27列填充黑色，我当时想，excel可以在某行列填充，而ppt不能，所以只能使用drawline这个函数来画点，而处理第1行第26列等数据用数组最好，而且点的大小要适中。大概就是这样吧。
ppt板块太小了，人也少，不适合学vba ppt，建议你到vba开发板块里，我现在画图片都用gdi及gdi+。

weiyingde

dongdonggege 发表于 2018-4-30 18:59
不好意思，今天才上网，没看到。你可以在百度搜索“vba 简笔画”，你可以搜到“用excel vba编程绘制一副 ...

实在是高，不错，给你点赞！！

dongdonggege

weiyingde 发表于 2020-5-10 08:13
实在是高，不错，给你点赞！！

数组的应用还不到位，共同提高吧。

dongdonggege

weiyingde 发表于 2020-5-10 08:13
实在是高，不错，给你点赞！！

另外我模仿的超级玛丽，http://club.excelhome.net/forum. ... 22&pid=10319789。
好像2007版，速度快，我没试，麻烦提点意见，

whx0910

很好啊    学习了

ning84

谢谢

1. Function DrawlineArr()
   
2.     Dim Arr(1 To 49)
   
3.     ''
   
4.     Arr(1) = Array(26, 27)
   
5.     Arr(2) = Array(25, 27)
   
6.     Arr(3) = Array(24, 26, 28)
   
7.     Arr(4) = Array(24, 26, 28)
   
8.     Arr(5) = Array(18, 19, 22, 23, 26, 28)
   
9.     Arr(6) = Array(18, 19, 22, 23, 26, 28)
   
10.     Arr(7) = Array(18, 20, 22, 23, 26, 28)
    
11.     Arr(8) = Array(17, 18, 20, 21, 23, 26, 28)
    
12.     Arr(9) = Array(16, 18, 20, 21, 23, 26, 28)
    
13.     Arr(10) = Array(16, 18, 20, 21, 23, 26, 28)
    
14.     Arr(11) = Array(15, 16, 18, 19, 20, 21, 23, 26, 28)
    
15.     Arr(12) = Array(15, 16, 18, 19, 20, 21, 23, 26, 28)
    
16.     Arr(13) = Array(14, 15, 17, 18, 20, 21, 23, 26, 28)
    
17.     Arr(14) = Array(14, 15, 18, 20, 21, 23, 29)
    
18.     Arr(15) = Array(14, 15, 17, 18, 20, 21, 24, 27, 29)
    
19.     Arr(16) = Array(13, 14, 17, 18, 20, 22, 24, 27, 29)
    
20.     Arr(17) = Array(13, 15, 17, 18, 20, 22, 24, 27, 29)
    
21.     Arr(18) = Array(13, 16, 17, 18, 20, 22, 24, 27, 29)
    
22.     Arr(19) = Array(12, 14, 16, 17, 19, 21, 23, 27, 29)
    
23.     Arr(20) = Array(12, 14, 16, 17, 19, 21, 23, 27, 29)
    
24.     Arr(21) = Array(12, 15, 16, 18, 19, 21, 27, 29)
    
25.     Arr(22) = Array(12, 13, 15, 16, 18, 20, 21, 27, 29, 33, 34, 35)
    
26.     Arr(23) = Array(12, 13, 15, 16, 18, 20, 27, 29, 32, 36)
    
27.     Arr(24) = Array(11, 12, 15, 17, 19, 21, 26, 28, 31, 34, 36)
    
28.     Arr(25) = Array(11, 13, 15, 18, 19, 26, 28, 30, 36, 37)
    
29.     Arr(26) = Array(11, 14, 16, 18, 20, 25, 27, 30, 35)
    
30.     Arr(27) = Array(12, 14, 16, 19, 24, 26, 29, 34)
    
31.     Arr(28) = Array(11, 15, 17, 20, 24, 26, 28, 34)
    
32.     Arr(29) = Array(11, 12, 15, 16, 17, 18, 19, 24, 26, 27, 34)
    
33.     Arr(30) = Array(11, 15, 18, 23, 26, 34)
    
34.     Arr(31) = Array(12, 13, 16, 17, 18, 26, 33)
    
35.     Arr(32) = Array(12, 16, 19, 27, 33)
    
36.     Arr(33) = Array(13, 14, 17, 18, 19, 20, 33)
    
37.     Arr(34) = Array(14, 15, 17, 33)
    
38.     Arr(35) = Array(6, 7, 8, 15, 16, 17, 33)
    
39.     Arr(36) = Array(5, 6, 9, 10, 16, 33)
    
40.     Arr(37) = Array(4, 11, 12, 14, 15, 32)
    
41.     Arr(38) = Array(4, 5, 6, 7, 8, 9, 13, 32)
    
42.     Arr(39) = Array(3, 32)
    
43.     Arr(40) = Array(4, 5, 6, 7, 8, 9, 10, 11, 31)
    
44.     Arr(41) = Array(3, 9, 10, 11, 31)
    
45.     Arr(42) = Array(2, 5, 6, 7, 8, 10, 30)
    
46.     Arr(43) = Array(3, 4, 7, 8, 9, 10, 13, 30)
    
47.     Arr(44) = Array(2, 5, 6, 9, 12, 14, 28, 29)
    
48.     Arr(45) = Array(3, 4, 8, 11, 15, 16, 17, 18, 27)
    
49.     Arr(46) = Array(3, 7, 10, 19, 20, 25, 26)
    
50.     Arr(47) = Array(4, 5, 9, 21, 22, 23, 24)
    
51.     Arr(48) = Array(5, 7, 8)
    
52.     Arr(49) = Array(6)
    
53.     DrawlineArr = Arr
    
54. End Function
    
55. 
    
56. Sub ll()
    
57. 
    
58.   Dim Pres As Presentation
    
59.       Set Pres = Application.ActivePresentation
    
60.   Dim Sld As Slide, Shp As Shape, Shps As Shapes
    
61.   Dim Arr
    
62.       Set Shps = Pres.Slides(2).Shapes
    
63. 
    
64.         For ii = Shps.Count To 1 Step -1
    
65.           Set Shp = Shps(ii)
    
66.           Shp.Delete
    
67.     Next ii
    
68.       
    
69.        Arr = DrawlineArr
    
70.         For i = 1 To UBound(Arr)
    
71.             For j = 0 To UBound(Arr(i))
    
72.                  Shps.AddLine Arr(i)(j) + 100, i * 1 + 200, Arr(i)(j) + 100 + 0.5, i * 1 + 200 + 0.5
    
73.                  
    
74.             Next
    
75.         Next
    
76.     Dim PlArr(3, 1)
    
77.         For ii = 0 To 3
    
78.            PlArr(ii, 0) = Arr(45)(ii * 2)
    
79.            PlArr(ii, 1) = Arr(45)(ii * 2 + 1)
    
80.         Next ii
    
81.         Stop
    
82. Dim pointsArray(1 To 3) As Variant
    
83.     pointsArray(1) = Array(100, 100) '第一个顶点坐标
    
84.     pointsArray(2) = Array(200, 200) '第二个顶点坐标
    
85.     pointsArray(3) = Array(150, 300) '第三个顶点坐标
    
86.         Shps.AddPolyline pointsArray
    
87.         
    
88.         Stop
    
89. End Sub
    

复制代码

dongdonggege

ning84 发表于 2024-11-14 19:54
谢谢

论坛都没有提示，要不是我想改编一下，都没看到。感谢指点，过去好几年了，数据点要是多一些，变成曲线画图，就好了。可以加我qq，我们共同探讨。

dongdonggege

ning84 发表于 2024-11-14 19:54
谢谢

我主要是学习ppt的，画图、动画为主。