模拟按钮按下效果

Question

我将宏分配给一个矩形形状，该形状将转到我工作簿中的下一个工作表。

我正在尝试向此矩形添加按下向上和向上的效果。

当我使用此代码时，只按下矩形，然后激活下一张纸，如果我返回到上一张纸，则释放矩形。

我需要的是按下矩形，然后在转到下一张纸之前释放。

有什么建议吗？

提前感谢你。

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

Answer 1

你最好使用'命令按钮'：形状和矩形对象并不真正支持你需要的事件驱动的'On Click'功能：调用相关的宏就是他们所做的全部。< / p>

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

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

大多数形状都具有“阴影”属性，并且由45度角（从左上角开始）投射的外部阴影会产生“凸起”效果。相反，从相反角度投射的内部阴影（来自右下角的光源）会产生“凹陷”效果。

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

在VBA中，形状阴影的光源“角度”为X和Y偏移，45度对应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)

...这就是您点击“向上”并点击“向下”按钮状态的代码。

我强烈建议您使用内置对话框来设置形状的填充颜色和阴影的大小，透明度和模糊。供您参考，下面列出了我用于智能“半平”浅灰色按钮的设置 - 但我不建议您在VBA代码中设置它们，因为这些格式不会按照您期望的顺序应用，并且按钮看起来不像您可以使用UI对话框构建的“干净”形状：

    ' 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)

你也可以使用3-D效果对话框，但这适用于大多数形状（包括你的矩形）的“凿子”效果：我没有找到任何预定义的“凸起”或“凹陷”三维样式的形状。

主要编辑：

猜猜在64位Office部署推出它们无法使用之前，谁正在考虑替换所有战术电子表格工具上的所有 Active-X控制按钮的工作？

所以你的问题确实非常非常有趣。以下是我正在做的事情：

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

这就是我正在使用的而不是ActiveX按钮：文本标签，矩形和图像，使用功能区上的“插入”菜单放入工作表。

这些对象都是Excel'Shapes'，它们都可以与命名宏相关联，并且它们具有共同的“阴影”效果，可用作“凸起按钮”3D效果。

以下示例是来自图像的函数调用（数据库的32 * 32图标，带有问号）作为工作表上的形状嵌入。我给这个ersatz控制按钮一个有意义的名字，我命名宏[Name]_Click()，因为我正在替换现有的'Click'事件程序。

因此，此宏是使用代码名称标识的工作表上的公共子例程， - 用户可以“重命名”工作表，更改用户可读标签，但不会重命名基础VBA类模块 - 当您右键单击形状时，它在'assign macro'列表中显示为MySheetCodeName.img_TestDefaultDSN_Click()。

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

Public Sub img_TestDefaultDSN_Click()

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

End Sub

在常规代码模块中调用一对通用的“Click Down”和“Click Up”子例程：

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

您可能对“控制按钮”的外观有自己的偏好，但这对我有用。

请注意，如果立即执行'Click Up'，则永远不会看到'Click Down'效果：即使'Sleep'或'Application Wait'语句将它们分开 - 您只会看到它，如果有真正的代码用户可检测的经过时间或模态对话框。

Answer 2

是否可以使用私人订阅。您只需要更改调用子例程的方式即可。要调用私有子程序，即使位于另一个代码模块中，也必须使用：

Application.Run "[ModuleName.]MacroName"[, arg1] [,arg2...],

此处详细介绍了所有内容：

https://wellsr.com/vba/2015/excel/3-ways-to-call-a-private-sub-from-another-module/