excel VBA如何制作浮动按钮？

Posted 2021-03-29

有一个代码，用于检查日期并用适当的颜色填充单元格，此代码包含一个按钮，当用户单击它时将运行VBA代码。

无论用户如何向下滚动，我都希望始终使按钮可见。

code:

Private Sub CommandButton1_Click()

Dim i As Long

For i = Range("C5000").End(xlUp).Row To 2 Step -1 'Range upto 5000, chnge this as per your requirment'


    If IsEmpty(Cells(i, 3)) Then
         Cells(i, 3).Interior.Color = xlNone

       ElseIf (VBA.CDate(Cells(i, 3)) - VBA.Date()) < 0 Then
             Cells(i, 3).Interior.Color = vbGreen

       ElseIf (VBA.CDate(Cells(i, 3)) - VBA.Date()) = 0 Then
             Cells(i, 3).Interior.Color = vbYellow

       ElseIf (VBA.CDate(Cells(i, 3)) - VBA.Date()) >= 1 And (VBA.CDate(Cells(i, 3)) - VBA.Date()) <= 4 Then
              Cells(i, 3).Interior.Color = vbRed

       ElseIf (VBA.CDate(Cells(i, 3)) - VBA.Date()) >= 5 And (VBA.CDate(Cells(i, 3)) - VBA.Date()) <= 10 Then
               Cells(i, 3).Interior.Color = vbCyan

    Else
                Cells(i, 3).Interior.ColorIndex = xlNone

 End If

    ' your 2nd criteria to color the entire row if "F" is not empty
    If Trim(Range("F" & i).Value) <> "" Then Range("D" & i & ":F" & i).Interior.ColorIndex = 15
    Debug.Print Len(Range("F" & i).Value)


Next
End Sub

我将不胜感激任何帮助。

答案

这里是：

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
    On Error GoTo 0
    With Cells(Windows(1).ScrollRow, Windows(1).ScrollColumn)
        CommandButton1.Top = .Top + 100
        CommandButton1.Left = .Left + 300
    End With
End Sub