Question

几天前我开始使用excel和vba。我现在达到了一个我想要尝试形状和东西的地步。我创建了一些过于花哨的概述页面，并希望让它更加花哨，仅仅是为了教育自己。但我似乎无法继续下去。

目前正在使用5个六边形。 2个周围的1个大的。

我希望较小的六边形（默认情况下位于大的六边形后面）通过鼠标悬停移动到外面并在鼠标离开大六边形时向后移动。但目前我只让他们搬一次。有什么建议？

EDIT1：我现在已经开始工作但看起来仍然很奇怪。我不知道如何让六边形移动得更顺畅。

我当前的代码

 Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x        
As Single, ByVal y As Single)
Dim ws As Worksheet
Set ws = Worksheets("Tests023")
Dim lngCurPos As POINTAPI
Dim MouseIsOver As Boolean
MouseIsOver = True

GetCursorPos lngCurPos
With ws.Shapes("Hexagon 6")
.Left = 50
.Top = 17
End With
With ws.Shapes("Hexagon 7")
.Left = 200
.Top = 100
End With
With ws.Shapes("Hexagon 8")
.Left = 200
.Top = 275
End With
With ws.Shapes("Hexagon 9")
.Left = 50
.Top = 375
End With


Application.Wait (1)

While MouseIsOver = True
GetCursorPos lngCurPos

Select Case lngCurPos.x
Case Is > 450
        MouseIsOver = False

Case Is < 20
        'Function move hexa back in

        MouseIsOver = False


 End Select
 GetCursorPos lngCurPos

'Select Case lngCurPos.y
'Case Is < 400

    'function move hexa back in

   ' MouseIsOver = False
'Case Is > 160
    'function move hexa back in

  '  MouseIsOver = False
'Case Else
   ' MouseIsOver = True
    'End Select

Wend
With ws.Shapes("Hexagon 6")
        .Left = 50
        .Top = 200
        End With
With ws.Shapes("Hexagon 7")
.Left = 50
.Top = 200
End With
With ws.Shapes("Hexagon 8")
.Left = 50
.Top = 200
End With
With ws.Shapes("Hexagon 9")
.Left = 50
.Top = 200
End With

End Sub

Answer 1

尝试将application.wait（1）替换为：

t=timer
do
 DoEvents
loop until t-timer>.2 ' this is the waiting time in secods, change at will

t是单个var

通过鼠标移动事件将形状移动到特定点，并在鼠标离开形状时向后移动

1 个答案: