模拟按钮按下效果

问题描述 投票：1回答：2

我已将宏指定为矩形形状，该形状将转到工作簿中的下一个工作表。

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

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

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

有什么建议？

提前谢谢你。

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
excel vba excel-vba
2个回答
0
投票

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

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

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

大多数形状具有“阴影”属性，并且由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)
你也可以使用三维效果对话框，但这适用于大多数形状（包括你的矩形）的'凿子'效果：I没有为形状找到任何预定义的“凸起”或“凹陷”三维样式。

Major Edit:

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

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

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

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

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

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

因此，这个宏是一个用代码名称标识的工作表上的公共子例程， - 用户可以“重命名”工作表，更改用户可读的标签，但是它们不会重命名基础VBA类模块 - 并且它在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'语句将它们分开 - 如果有真实代码与用户分开，您也只能看到它可检测的经过时间或模态对话框。

0
投票

是否可以使用私人潜艇。您只需要更改调用子例程的方式。要调用private sub，甚至位于另一个代码模块中，您必须使用：

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

这里详细解释了一切：

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

最新问题
© www.soinside.com 2019 - 2024. All rights reserved.