VBA制作简单的按键精灵

Enum RetCode
    ErrRT = -1
    SuccRT = 1
End Enum

Enum Pos
    RowStart = 2
    KeyCol = 2
    Cols = 6  
End Enum

Type DataStruct
    Src() As Variant
    Rows As Long
    Cols As Long
End Type

Sub vba_main()
    Dim d As DataStruct
    
    If RetCode.ErrRT = ReadSrc(d) Then Exit Sub
    
    '如果找不准其他系统的窗口名称，这一句可以省略，把MySleep时间加大一些，这样可以点运行程序后，用鼠标点击去激活窗口
    VBA.AppActivate "好高级的系统.txt - 记事本"
    MySleep 1
    
    If RetCode.ErrRT = GetResult(d) Then Exit Sub
End Sub

Private Function GetResult(d As DataStruct) As RetCode
    Dim i As Long, j As Long
    
    For i = Pos.RowStart To d.Rows
        For j = 1 To Pos.Cols
            VBA.SendKeys VBA.CStr(d.Src(i, j)), True
            
            If j = Pos.Cols Then
                VBA.SendKeys "{ENTER}"
            Else
                VBA.SendKeys "{TAB}"
            End If
            '这个等待时间看自己电脑情况来调节，电脑不好就时间大一些，让电脑有足够的时间反应
            MySleep 0.5
        Next j
    Next
End Function

Private Function ReadSrc(d As DataStruct) As RetCode
    ReadSrc = ReadData(d.Src, d.Rows, Pos.Cols, Pos.KeyCol, Pos.RowStart)
End Function

Private Function ReadData(ByRef RetArr() As Variant, ByRef RetRow As Long, Cols As Long, KeyCol As Long, RowStart As Long) As RetCode
    ActiveSheet.AutoFilterMode = False
    RetRow = Cells(Cells.Rows.Count, KeyCol).End(xlUp).Row
    If RetRow < RowStart Then
        MsgBox "没有数据"
        ReadData = RetCode.ErrRT
        Exit Function
    End If
    RetArr = Cells(1, 1).Resize(RetRow, Cols).Value

    ReadData = RetCode.SuccRT
End Function

Function MySleep(Interval As Double) As RetCode
    Dim t As Double
    t = VBA.Timer()
    
    Do Until VBA.Timer() - t > Interval
        VBA.DoEvents
    Loop
End Function