Ich habe eine Schaltfläche in Excel, die als ActiveX-Steuerelement funktionierte, musste in Form wechseln, jetzt funktioniert es nicht 100%

Question

Ich erstellte eine ActiveX-Schaltfläche für einen Tracker Ich wurde mit dem Bau bei der Arbeit beauftragt, ActiveX-Taste funktionierte großartig, aber da waren endlose Kompatibilität und Erlaubnisprobleme, als ich es aussandte. Beschlossen, es stattdessen zu einer Makro-fähigen Form zu machen. Es sollte eine einfache Schaltfläche sein, die, wenn Sie darauf klicken, die aktuelle Uhrzeit und das Datum in die aktive Zelle eingibt. Das funktioniert, das Problem ist, dass es nicht mehr so ​​schwebt, wie ich es hatte, als es eine Activex-Taste war, es folgt nicht der aktiven Zelle auf der Seite. Auch - da es nicht activex ist, simuliert es nicht einen Knopfklick, den ich versuchte zu kodieren, und alles sieht richtig aus, aber es gibt keine Depression, wenn ich darauf klicke. Hier ist, was ich bisher habe.

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

Shape-Objekte haben nicht die gleichen Methoden wie ein ActiveX-Objekt. Sie sind auch nur in der Excel-Arbeitsmappe vorhanden, nicht in VB. Sie können also nicht einfach auf sie verweisen, indem Sie eine Methode mit demselben Namen wie das Objekt erstellen. Sie können diese beiden Subs zu einem zusammenführen und dann das Sub-Objekt dem Button zuweisen, indem Sie mit der rechten Maustaste darauf klicken und die "Assign Macro ..." Option verwenden, um dieses Sub zu setzen.

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 

Was das immer es um das Blatt zu folgen, müssen Sie zunächst eine gültige Referenz auf das Form-Objekt zu erhalten (dieser Code muss innerhalb des Moduls für das Arbeitsblatt Ihrer Schaltfläche ist in sein).

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

Die Veränderung der Form geschieht so schnell, dass das menschliche Auge kaum sehen kann. Ich setze eine for-Schleife, um die Änderung lange genug sichtbar zu halten, damit der Benutzer den Schlüsselklick zu schätzen weiß.

Fügen Sie den folgenden Code in ein reguläres Modul ein, nicht in Ihr Arbeitsblattmodul. Löschen Sie den gesamten Arbeitsblattmodulcode, der sich auf diese Form bezieht.

Dann klicken Sie mit der rechten Maustaste auf Ihre Form und "Makro zuweisen" - zu diesem im regulären Modul. Ich weiß nicht, wie man es an Ort und Stelle hält, wenn der Benutzer scrollt, aber zumindest wird dies Ihr visuelles Problem beheben.

Ich habe auch die Datumsänderung Zelle A1 hinzugefügt.

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