Excel 中有一个用作 ActiveX 控件的按钮，必须切换到形状，现在它无法 100% 工作

Question

我为我在工作中负责构建的跟踪器创建了一个 activex 按钮，activex 按钮工作得很好，但是当我发送它时存在无休止的兼容性和权限问题。决定将其改为启用宏的形状。它应该是一个简单的按钮，当您单击它时，它会将当前时间和日期输入到活动单元格中。这行得通，问题是它不再像我在它是 activex 按钮时那样浮动，它不跟随页面下方的活动单元格。另外——因为它不是 activex，所以它不模拟按钮点击，我试图在其中编码，一切 看起来 都是正确的，但是当我点击它时没有压抑。这是我目前所拥有的。

Sub RectangleRoundedCorners1()
Dim vTopType As Variant
Dim iTopInset As Integer
Dim iTopDepth As Integer

    With ActiveSheet.Shapes(Application.Caller).ThreeD
        vTopType = .BevelTopType
        iTopInset = .BevelTopInset
        iTopDepth = .BevelTopDepth
    End With

    With ActiveSheet.Shapes(Application.Caller).ThreeD
        .BevelTopType = msoBevelSoftRound
        .BevelTopInset = 12
        .BevelTopDepth = 4
    End With
    Application.ScreenUpdating = True

    With ActiveSheet.Shapes(Application.Caller).ThreeD
        .BevelTopType = vTopType
        .BevelTopInset = iTopInset
        .BevelTopDepth = iTopDepth
    End With
End Sub

Sub RectangleRoundedCorners1_Click()
    ActiveCell.Value = Now()
    ActiveCell.NumberFormat = "MM/DD/YY hh:mm:ss"
End Sub

Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
    With Cells(Windows(1).ScrollRow, Windows(1).ScrollColumn)
        RectangleRoundedCorners1.Top = .Top + 10
        RectangleRoundedCorners1.Left = .Left + 825

    End With
End Sub

Answer 1

形状对象没有与 ActiveX 对象相同的方法。它们也只存在于 Excel 工作簿中，而不存在于 VB 中，因此您不能通过创建与对象同名的方法来引用它们。您可以将这两个 sub 合并为一个，然后通过右键单击该按钮并使用 "Assign Macro..." 选项将其设置为它来将该子分配给该按钮。

Sub ButtonClick()
Dim vTopType As Variant
Dim iTopInset As Integer
Dim iTopDepth As Integer

    With ActiveSheet.Shapes(Application.Caller).ThreeD
        vTopType = .BevelTopType
        iTopInset = .BevelTopInset
        iTopDepth = .BevelTopDepth
    End With

    With ActiveSheet.Shapes(Application.Caller).ThreeD
        .BevelTopType = msoBevelSoftRound
        .BevelTopInset = 12
        .BevelTopDepth = 4
    End With
    Application.ScreenUpdating = True

    With ActiveSheet.Shapes(Application.Caller).ThreeD
        .BevelTopType = vTopType
        .BevelTopInset = iTopInset
        .BevelTopDepth = iTopDepth
    End With

    ActiveCell.Value = Now()
    ActiveCell.NumberFormat = "MM/DD/YY hh:mm:ss"
End Sub

至于让它跟随 sheet，您需要首先获得对形状对象的有效引用（此代码需要在工作模块中sheet 您的按钮在）。

Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

Dim shButton As Shape

Set shButton = Shapes("RectangleRoundedCorners1")

With Cells(Windows(1).ScrollRow, Windows(1).ScrollColumn)
    shButton.Top = .Top + 10
    shButton.Left = .Left + 825
End With

End Sub

Answer 2

形状的变化发生得如此之快，以至于人眼几乎看不到它。我放置了一个 for 循环以保持更改可见足够长的时间，以便用户能够欣赏按键点击。

将以下代码放入常规模块，而不是您的工作表模块。删除与此形状相关的所有工作表模块代码。

然后右键单击您的形状，然后 "Assign Macro" - 到常规模块中的这个。我不知道如何让它在用户滚动时保持原位，但至少这会解决你的视觉问题。

我还在单元格 A1 中添加了日期更改。

Sub RectangleRoundedCorners1()
Dim vTopType As Variant
Dim iTopInset As Integer
Dim iTopDepth As Integer

    With ActiveSheet.Shapes(Application.Caller).ThreeD
        vTopType = .BevelTopType
        iTopInset = .BevelTopInset
        iTopDepth = .BevelTopDepth
    End With

For i = 1 To 70
'   This change happens too quickly for the eye to see
'   Put a small for loop so the visual change can be seen
    With ActiveSheet.Shapes(Application.Caller).ThreeD
        .BevelTopType = msoBevelSoftRound
        .BevelTopInset = 12
        .BevelTopDepth = 4
        .Visible = True
    End With
    Application.ScreenUpdating = True
    ActiveSheet.Shapes(Application.Caller).ThreeD.Visible = True
Next i

    With ActiveSheet.Shapes(Application.Caller).ThreeD
        .BevelTopType = vTopType
        .BevelTopInset = iTopInset
        .BevelTopDepth = iTopDepth
    End With


   ActiveSheet.Range("A1").Value = Format(Now(), "mmm dd, yyyy")

End Sub

Excel 中有一个用作 ActiveX 控件的按钮，必须切换到形状，现在它无法 100% 工作

Got a button in Excel that was working as an ActiveX control, had to switch to shape, now it's not working 100%

excel

vba

activex

shape