模拟按钮按压效果 [英] Simulate button press effect

问题描述

我正在尝试添加一个按下来的效果到这个矩形。

当我使用这个代码时，矩形只被按下，然后下一张工作表被激活，如果我返回上一张表格，矩形是发布。

我需要的是，矩形被按下，然后在进入下一张表之前被释放。

任何建议？

提前谢谢。

  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）
 
使用MyButton 
'记录原始按钮属性。 
 oHeight = .Height 
 oWidth = .Width 
 oTop = .Top 
 oLeft = .Left 
'按钮向下（模拟按钮单击）。 
 .ScaleHeight 0.9，msoFalse 
 .ScaleWidth 0.9，msoFalse 
 cHeight = .Height 
 cWidth = .Width 
 .Top = oTop +（（oHeight  -  cHeight）/ 2）
 .Left = oLeft +（（oWidth  -  cWidth）/ 2）
结束
 
'将MyButton变量设置为Nothing以释放内存。 
设置MyButton = Nothing 
 End Sub 
 
 Public Sub ReleaseButton（）
设置MyButton = ActiveSheet.Shapes（Application.Caller）
 
使用MyButton 
'按钮（设置回原始按钮属性）。 
 .Height = oHeight 
 .Width = oWidth 
 .Top = oTop 
 .Left = oLeft 
结束
 
'设置MyButton变量没有什么可以释放内存
 Set MyButton = Nothing 
 End Sub 
 
 Public Sub NextPage（）
 PressButton 
 Application.Wait（Now + TimeSerial（0，0，1） ）
 ReleaseButton 
 
 Dim ws As Worksheet 
 
设置ws = ActiveSheet 
 
尽管不是ws.Next.Visible = xlSheetVisible 
设置ws = ws.Next 
循环
 
与ws.Next 
 .Activate 
 .Range（A1）。选择
结束与
 End Sub 
  

解决方案

使用命令按钮：形状和矩形对象并不真正支持您需要的事件驱动的点击功能：调用关联的宏几乎是他们所做的。

但是，您可能会遇到这种形状，因为您的界面（支持ActiveX命令按钮在64位环境中非常差），所以这里...

背景：如何使按钮看起来像一个按钮：

大多数形状都有一个阴影属性，而一个来自45度角的光源投射的外部阴影（从顶部 - 左上角）给出了提升效果。相反，从相反的角度（从右下角的光源）投射的内部阴影会产生下沉效果。

在实践中，内部阴影对于两者都是足够好的：只是改变角度。

在VBA中，您的形状阴影的光源的角度以X和Y偏移量给出， 45度对应于1.14142：

 
 Dim oShape As Excel.Shape 
 Dim oShadow As Excel.ShadowFormat 
 
设置oShape = ActiveSheet.Shapes（i）
设置oShadow = oShape.Shadow 
 
'从右上角的光线在45度角投射对于提升效果：
 oShadow.OffsetX = Sqr（2）
 oShadow.OffsetY = Sqr（2）
 
'从右上角的光线施加阴影45度的下沉效应：
 oShadow.OffsetX = -Sqr（2）
 oShadow.OffsetY = -Sqr（2）
 
 

...那就是你点击上的代码，c舔下按钮状态。

我强烈建议您使用内置对话框来设置形状的填充颜色和阴影的大小，透明度和模糊度。为了您的参考，我使用的智能半平浅灰色按钮的设置如下所示，但我不建议您将其设置为VBA代码，因为这些格式将不会按照您期望的顺序应用，该按钮不会像您可以使用UI对话框构建的干净形状：

浅灰色按钮，稍微较暗的软化边框
 oShape.Fill.ForeColor.RGB =& HD8D8D8 
 oShape.Line.ForeColor.RGB =& HC0C0C0 
 oShape.Line.Weight = 2 
 oShape.Line.Transparency = 0.75 
 
'使用形状的阴影给出提升按钮效果：
 oShadow.Style = msoShadowStyleInnerShadow 
 oShadow.Visible = True 
 oShadow.Blur = 2 
 oShadow.Size = 100 
 oShadow.Transparency = 0.5 
 
'由右上角的45度的上升效果投射的阴影：
 oShadow。 OffsetX = Sqr（2）
 oShadow.OffsetY = Sqr（2）
 
 

您还可以使用3-D效果对话框，但这对大多数形状（包括矩形）的凿子效果起作用：I没有发现任何预定义的凸起或凹陷三维形状的风格。

主要编辑：

猜猜谁看着替换全部所有的战术电子表格工具上的Active-X控制按钮在64位Office推出之前使其无法运行？

所以你的问题变得非常，真的很有趣。以下是我正在做的：

通用的按钮单击代码使用Excel'Shape'对象调用VBA宏而不是ActiveX控件。

这是我正在使用的而不是ActiveX按钮：文本标签，矩形和图像，放在工作表中使用插入菜单上色带。

这些对象都是Excel的形状，它们都可以与命名的宏相关联，并且它们具有常见的阴影效果，用作升高的按钮'3D效果。

下面的例子是一个图像的函数调用（它是一个32 * 32图标，一个数据库，带有一个问号）嵌入一个形状工作表。我给了这个ersatz控件按钮一个有意义的名字，我命名为宏 [Name] _Click（），因为我正在替换现有的点击事件过程。 p>

因此，这个宏是使用代码名称标识的工作表上的公共子例程，用户可以重命名工作表，更改用户可读标签，但是它们不会重命名底层的VBA类模块，并且当您右键单击该形状时，它将在分配宏列表中显示为 MySheetCodeName.img_TestDefaultDSN_Click（） 。

..这就是为什么它是公共的（不是私人的，因为ActiveX控件的自动创建的事件过程存根将是）：私有subs在'分配宏列表。

 
 Public Sub img_TestDefaultDSN_Click（）
 
 ClickDown Me.Shapes（img_TestDefaultDB）
 ShowDBStatusEOD_Reports_DSN 
 ClickUp Me.Shapes（img_TestDefaultDB）
 
 End Sub 
 
 

在常规代码模块中，这将调用一对通用的点击和单击子程序：

 
公共功能ClickDown（objShape作为Excel.Shape）
错误恢复下一步
 
'从右下角到左上角重新创建按钮阴影：
使用objShape。 Shadow 
 .Visible = msoFalse 
 .OffsetX = -1.2 
 .OffsetY = -1.2 
 .Visible = msoTrue 
 .Blur = 1 
 .Size = 99 
。透明度= 0.75 
 .Style = msoShadowStyleInnerShadow 
 .Obscured = msoFalse 
结束与
 
'稍微加深按钮面：
如果objShape.Type = msoPicture Then 
 With objShape.PictureFormat 
 .Brightness = .Brightness  -  0.01 
 En d with 
 Else 
 With objShape.Fill 
 .Visible = msoTrue 
 .ForeColor.Brightness = .ForeColor.Brightness  -  0.01 
 End with 
 End If 
 
结束功能
 
 
公共功能ClickUp（objShape为Excel.Shape）
错误恢复下一页
 
'恢复按钮面对它的默认亮度：
带objShape.Shadow 
 .Visible = msoFalse 
 .OffsetX = 1.2 
 .OffsetY = 1.2 
 .Visible = msoTrue 
 .Blur = 1 
 .Size = 99 
 .Transparency = 0.75 
 .Style = msoShadowStyleInnerShadow 
 .Obscured = msoFalse 
结束与
 
'将按钮阴影恢复到右下角：
如果objShape.Type = msoPicture Then 
 With objShape.PictureFormat 
 .Brightness = .Brightness + 0.01 
 End with 
 Else 
带objShape.Fill 
 .Visible = msoTrue 
 .ForeColor.Brightness = .ForeColor.Brightness + 0.01 
结束
 En d如果
 
结束功能
 
 

您可能拥有自己的喜好， '控制按钮'，但这对我有用。请注意，如果单击立即执行，则点击向下效果将不会被看到：即使休眠或应用程序等待语句将它们分隔开 - 你只会看到它是否有真实的代码，用户可以检测到的逝去的时间或模态对话框。

I have macro assigned to a rectangle shape that goes to the next sheet in my workbook.

I'm trying to add a press down and up effect to this rectangle.

When I use this code, the rectangle is only pressed down then then the next sheet is activated, and if I returned back to the previous sheet, the rectangle is released.

Wht I need is that the rectangle is pressed down and then released before going to the next sheet.

Any suggestions?

Thank u in advance.

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

解决方案

You're better off using a 'Command Button': shapes and rectangle objects don't really support the event-driven 'On Click' functionality you need here: calling an associated macro is pretty much all that they do.

However, you may well be stuck with that shape as your interface (support for ActiveX command buttons is very poor in 64-bit environments), so here goes...

Background: how to make a button look like a button:

Most shapes have a 'Shadow' property, and an outside shadow cast by a light source from a 45-degree angle (from the top-left corner) gives a 'raised' effect. Conversely, an inside shadow cast from the opposite angle (from a light source off the bottom-right corner) gives a 'sunken' effect.

In practice, an inside shadow for both is good enough: just change the angle.

In VBA, the 'angle' of the light source for your shape's shadow is given as X and Y offsets, and 45 degrees corresponds to 1.14142:

Dim oShape As Excel.Shape
Dim oShadow As Excel.ShadowFormat

    Set oShape = ActiveSheet.Shapes(i)
    Set oShadow = oShape.Shadow

   ' Shadow cast by light from above-right at 45 degrees for a 'raised' effect:
    oShadow.OffsetX = Sqr(2)
    oShadow.OffsetY = Sqr(2)

   ' Shadow cast by light from above-right at minus 45 degrees for a 'sunken' effect:
    oShadow.OffsetX = -Sqr(2)
    oShadow.OffsetY = -Sqr(2)

...And that's the code for your click 'up' and click 'down' button state.

I Strongly recommend that you use the built-in dialogs to set the shape's fill colour and the shadow's size, transparency and blur. For your reference, the settings I use for a smart 'semi-flat' light grey button are listed below - but I do not recommend that you set them in VBA code, as these formats will not be applied in the order you expect, and the button will not look like the 'clean' shape you can build using the UI dialogs:

    ' Light-grey button with a slightly darker 'softened' border
    oShape.Fill.ForeColor.RGB = &HD8D8D8
    oShape.Line.ForeColor.RGB = &HC0C0C0
    oShape.Line.Weight = 2
    oShape.Line.Transparency = 0.75

   ' Use the shape's shadow to give a 'raised button' effect:
    oShadow.Style = msoShadowStyleInnerShadow
    oShadow.Visible = True
    oShadow.Blur = 2
    oShadow.Size = 100
    oShadow.Transparency = 0.5

   ' Shadow cast by light from above-right at 45 degrees for a 'raised' effect:
    oShadow.OffsetX = Sqr(2)
    oShadow.OffsetY = Sqr(2)

You can also use the 3-D effects dialog, but this works by a 'chisel' effect for most shapes (including your rectangle): I haven't found any predefined 'raised' or 'sunken' three-D styles for shapes.

Major Edit:

Guess who's looking at the job of replacing all the Active-X control buttons on all the tactical spreadsheet tools before the 64-Bit Office rollout renders them inoperable?

So your question just became very, very interesting indeed. Here's what I'm doing about that:

Generic 'Button Click' code for using Excel 'Shape' objects to call a VBA Macro instead of ActiveX controls.

This is what I'm using instead of ActiveX buttons: text labels, rectangles and images, placed into the worksheet using the 'Insert' menu on the Ribbon.

These objects are all Excel 'Shapes', they can all be associated with a named macro, and they have a common 'shadow' effect that serves as a 'raised button' 3D effect.

The example below is a function call from an image (it's a 32*32 icon for a database, with a question mark) embedded as a shape on a worksheet. I gave this ersatz control button a meaningful name, and I named the macro [Name]_Click(), because I'm replacing the existing 'Click' event procedures.

So this macro is a public subroutine on a worksheet identified with a code name, - users can 'rename' the sheet, changing the user-readable label, but they won't rename the underlying VBA class module - and it's visible as MySheetCodeName.img_TestDefaultDSN_Click() in the 'assign macro' list when you right-click the shape.

..That's why it's Public (not Private, as the automatically-created event procedure stubs for ActiveX controls will be): private subs aren't visible in the 'Assign Macro' list.

Public Sub img_TestDefaultDSN_Click()

ClickDown Me.Shapes("img_TestDefaultDB")
ShowDBStatus "EOD_Reports_DSN"
ClickUp Me.Shapes("img_TestDefaultDB")

End Sub

This calls a pair of generic 'Click Down' and 'Click Up' subroutines, in a regular code module:

Public Function ClickDown(objShape As Excel.Shape)
On Error Resume Next

'Recast the button shadow from bottom-right to top-left:
With objShape.Shadow
   .Visible = msoFalse
    .OffsetX = -1.2
    .OffsetY = -1.2
    .Visible = msoTrue
    .Blur = 1
    .Size = 99
    .Transparency = 0.75
    .Style = msoShadowStyleInnerShadow
    .Obscured = msoFalse
End With

'Darken the button face slightly:
If objShape.Type = msoPicture Then
    With objShape.PictureFormat
        .Brightness = .Brightness - 0.01
    End With
Else
    With objShape.Fill
       .Visible = msoTrue
       .ForeColor.Brightness = .ForeColor.Brightness - 0.01
    End With
End If

End Function


Public Function ClickUp(objShape As Excel.Shape)
On Error Resume Next

'Restore the button face to it's default brightness:
With objShape.Shadow
    .Visible = msoFalse
    .OffsetX = 1.2
    .OffsetY = 1.2
    .Visible = msoTrue
    .Blur = 1
    .Size = 99
    .Transparency = 0.75
    .Style = msoShadowStyleInnerShadow
    .Obscured = msoFalse
End With

'Restore the button shadow to bottom-right:
If objShape.Type = msoPicture Then
    With objShape.PictureFormat
        .Brightness = .Brightness + 0.01
    End With
Else
    With objShape.Fill
       .Visible = msoTrue
       .ForeColor.Brightness = .ForeColor.Brightness + 0.01
    End With
End If

End Function

You may well have your own preferences for the appearance of a 'control button', but this works for me.

Note that the 'Click Down' effect is never seen if 'Click Up' follows immediately: nor even if a 'Sleep' or an 'Application Wait' statement separates them - you'll only see it if there's real code with a user-detectable elapsed time or a modal dialog.

这篇关于模拟按钮按压效果的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！