|
楼主 |
发表于 2010-9-10 16:47
|
显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
4、DrawLine函数只能画,不能擦除
Sub draw(ByVal X As Integer, ByVal Y As Integer, ByVal Radius As Integer)
Dim name As String
stp = 0
Do While stp = 0
Call cls
Angle = (Angle + ScrollBar1.Value) Mod 360
XO = X + Radius * Cos(Angle * pi / 180)
YO = Y + Radius * Sin(Angle * pi / 180)
xs = Sqr((4 * Radius) ^ 2 - 10 ^ 2) + XO '4 * Radius + X0
With ActivePresentation.Slides(1)
.Shapes("d").Left = XO
.Shapes("d").Top = YO
.Shapes("k").Left = xs - .Shapes("k").Width / 2
.Shapes("k").Top = Y - .Shapes("k").Height / 2
End With
DoEvents
If stp = 1 Then End
With ActivePresentation.SlideShowWindow.View
.PointerColor.RGB = RGB(0, 0, 0)
.drawLine X, Y, XO, YO + 3
.drawLine xs, Y, XO, YO + 3
End With
Set myDocument = ActivePresentation.Slides(1).Shapes
If stp = 2 Then
Call cls
With myDocument
.AddLine(X, Y, XO + 2, YO + 3).name = "1"
.AddLine(xs, Y, XO, YO + 3).name = "2"
End With
CommandButton1.Caption = "继续"
End If
Loop
End Sub
出于版权归属考虑,完整代码请联系
魅力老猫MM@QQ号#mllm(252908496)
对比在2007和2010下的运行结果,可见运行轨迹在2010时完全是默涂涂,2007下正常。
解决方案:暂无
[ 本帖最后由 儒道佛 于 2010-9-10 16:48 编辑 ] |
|