Получил кнопку в Excel, которая работала как элемент управления ActiveX, пришлось переключиться на фигуру, теперь она не работает 100%

Question

Я создал кнопку 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 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 

Что касается получения его следовать за листом, вам необходимо получить действительную ссылку на объект формы первой (этот код должен быть внутри модуля для листа вашей кнопки находится в).

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, чтобы изменения были видимыми достаточно долго, чтобы пользователь оценил нажатие клавиши.

Вставьте следующий код в обычный модуль, а не в ваш рабочий лист. Удалите весь код вашего рабочего листа, связанный с этой формой.

Затем щелкните правой кнопкой мыши по вашей фигуре и выберите «Присвоить макрос» - этому в обычном модуле. Я не знаю, как заставить его оставаться на месте, когда пользователь прокручивается, но, по крайней мере, это устранит вашу визуальную проблему.

Я также добавил изменение даты в ячейку 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