VBA，shape的移动 shape.incrementLeft 和 shape.incrementTop

最新推荐文章于 2025-03-18 09:03:54 发布

奔跑的犀牛先生

最新推荐文章于 2025-03-18 09:03:54 发布

阅读量1.8k

点赞数 1

分类专栏： VBA

本文链接：https://blog.csdn.net/xuemanqianshan/article/details/112122582

版权

VBA 专栏收录该内容

184 篇文章

订阅专栏

实现移动

Sub ftest11()
Dim p1 As Shape
Dim t1 As Double

Set p1 = Worksheets("sheet7").Shapes.AddShape(msoShapeOval, 100, 100, 200, 100)
    p1.Fill.ForeColor.RGB = RGB(0, 0, 250)

With p1.ThreeD
   .Visible = True
   .Depth = 100
   .ExtrusionColor.RGB = RGB(255, 0, 0)
End With

t1 = Timer
i = 0
Do Until i >= 60
   DoEvents
   If Timer - t1 > 0.2 Then
      i = i + 1
      p1.IncrementLeft 10 * Rnd()
      p1.IncrementTop 10 * Rnd()
      t1 = Timer
   End If
   
Loop

p1.Delete

End Sub

实现发子弹类似效果

Sub ftest12()
Dim p1, p2 As Shape
Dim t1 As Double

Set p1 = Worksheets("sheet7").Shapes.AddShape(msoShapeOval, 100, 100, 50, 20)
    p1.Fill.ForeColor.RGB = RGB(0, 0, 250)


t1 = Timer
i = 0
Do While True
   DoEvents

       
   If Timer - t1 > 1 Then
   
      Set p2 = p1.Duplicate
      i = i + 1
      p2.IncrementLeft 100 * i
      t1 = Timer
      
'        If i > 1 Then
'           p2.Delete   '如何实现子弹的消失呢
'        End If
      
   End If
Loop

End Sub