Ich habe ein Makro einer Rechteckform zugewiesen, die zum nächsten Blatt in meiner Arbeitsmappe wechselt.

Ich versuche, diesem Rechteck einen Drück-Rauf-Effekt hinzuzufügen.

Wenn ich diesen Code verwende, wird das Rechteck nur nach unten gedrückt, und dann wird das nächste Blatt aktiviert. Wenn ich zum vorherigen Blatt zurückkehre, wird das Rechteck freigegeben.

Was ich brauche, ist, dass das Rechteck nach unten gedrückt und dann losgelassen wird, bevor zum nächsten Blatt übergegangen wird.

Irgendwelche Vorschläge

Vielen Dank im Voraus.

Dim MyButton As Shape
Dim oHeight, oWidth, cHeight, cWidth As Double
Dim oTop, oLeft As Long

Public Sub PressButton()
    Set MyButton = ActiveSheet.Shapes(Application.Caller)

    With MyButton
        'Record original button properties.
        oHeight = .Height
        oWidth = .Width
        oTop = .Top
        oLeft = .Left
        'Button Down (Simulate button click).
        .ScaleHeight 0.9, msoFalse
        .ScaleWidth 0.9, msoFalse
        cHeight = .Height
        cWidth = .Width
        .Top = oTop + ((oHeight - cHeight) / 2)
        .Left = oLeft + ((oWidth - cWidth) / 2)
    End With

    'Set MyButton variable to Nothing to free memory.
    Set MyButton = Nothing
End Sub

Public Sub ReleaseButton()
    Set MyButton = ActiveSheet.Shapes(Application.Caller)

    With MyButton
        'Button Up (Set back to original button properties).
        .Height = oHeight
        .Width = oWidth
        .Top = oTop
        .Left = oLeft
    End With

    'Set MyButton variable to Nothing to free memory.
    Set MyButton = Nothing
End Sub

Public Sub NextPage()
    PressButton
    Application.Wait (Now + TimeSerial(0, 0, 1))
    ReleaseButton

    Dim ws As Worksheet

    Set ws = ActiveSheet

    Do While Not ws.Next.Visible = xlSheetVisible
        Set ws = ws.Next
    Loop

    With ws.Next
        .Activate
        .Range("A1").Select
    End With
End Sub