VBA制作简单的按键精灵

2020-07-28 10:24:57 浏览数 (1)

1、需求:

将Excel里的数据,输入到其他软件。

2、举例:

还是接着上前面的例子,公司突然要用系统来管理人员信息了,但是由于开发时间过于仓促,竟然没有从Excel导入的功能(好像挺说不通啊!)。你需要把统计好的10几万数据一个一个的输入到系统里(估计真有这种事的话你要辞职了)!

但是我工作中真有类似的例子,估计是单位财务系统的版本太旧,又或者是没人去研究系统,同事做凭证都是手敲进去的。平时一些小的报销凭证还好,可是有些工资、成本的相关的凭证,一个凭证分录有的多达几百条,他们都是靠手敲的!

3、代码实现

Excel VBA作为一种编程语言,虽然不适合开发什么大型的软件系统,但是从理论讲,还是可以实现任何语言能实现的功能的,所以在VBA里也没什么是不可能的。这种简单的按键精灵在VBA里很容易,甚至不用调用API,VBA已经帮我们封装好了功能,那就是SendKeys。

只要我们正确找准每一行的数据输入的步骤,加上合适的等待时间保证电脑不会因为卡顿影响,就能够顺利的完成数据的输入。

我们按照前面例子的数据,假设每一行数据输入的时候,输完1个单元格的内容就按一次Table键,在一行数据的最后输入Enter键到下一行,我这里就直接用1个txt文档演示:

代码语言:javascript复制
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

程序是比较简单的,只要自己多试试,控制好MySleep的时间就好,程序运行的过程不要去操作鼠标和键盘。

另外:

  • 输入法会对输入的内容有影响,最好调成英文状态
  • 如果确实数据太多了,可以分开多次来输入
  • 一些特殊字符或者功能键需要放在“{}”内,具体请查看SendKeys的帮助文件
vba

0 人点赞