Mrrrr's Forum (VIEW ONLY)
Un forum care ofera solutii pentru unele probleme legate in general de PC. Pe langa solutii, aici puteti gasi si alte lucruri interesante // A forum that offers solutions to some PC related issues. Besides these, here you can find more interesting stuff. 		Lista Forumurilor Pe Tematici
Mrrrr's Forum (VIEW ONLY) | Reguli | Inregistrare | Login

POZE MRRRR'S FORUM (VIEW ONLY)

Nu sunteti logat. 		Nou pe simpatie:
Cosminamoraru
Femeie
25 ani
Bacau
cauta Barbat
26 - 80 ani
Mrrrr's Forum (VIEW ONLY) / Tutoriale si Ghiduri Utile // Tutorials and useful guides / [EXCEL] Add Shape Button that Simulates Button Press [VBA] Moderat de TRaP, TonyTzu
Autor
Mesaj Pagini: 1
Mrrrr
AdMiN

Inregistrat: acum 17 ani
Postari: 2228
Source:

First things first: I created a shape and added a bottom right inner shadow to it.
Then added the following code and linked the CountClicks macro to the shape.

This is the result:



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.95, msoFalse
        .ScaleWidth 0.95, 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 CountClicks()
    PressButton
    Application.ScreenUpdating = True
    Application.Wait (Now + TimeSerial(0, 0, 1))
    ReleaseButton
    Application.ScreenUpdating = True
    Application.Wait (Now + TimeSerial(0, 0, 0))
   
Static clicks As Integer
    clicks = clicks + 1
Debug.Print clicks
   
End Sub


More:

Excel button animation ,Icon animation, mouse hover animation in Excel just like in web pages:




_______________________________________
pus acum 5 ani
   
Pagini: 1  

Mergi la