基本信息

---

下载

   友情提示：（无需注册或充值，赞助后即可获取资源下载链接）

---

     嘿，亲！知识可是无价之宝呢，但咱这精心整理的资料也耗费了不少心血呀。小小地破费一下，绝对物超所值哦！如有下载和支付问题，请联系我们QQ(微信同号)：813200300

本次赞助数额为： 2 元　

支付宝支付

微信支付

   源码介绍

---

可以存取excel文件

Private Sub List2_DblClick()
    On Error GoTo eee
    lineNo = lineN                                                              '重新选择文件以后的默认行数
    lieNO = lieN
    
    xlsChanged = False
    endNO = 0
    
    xlsPath = List2.Text                                                        '单击选择xlsx
    If xlsApp Is Nothing Then
        Set xlsApp = CreateObject("Excel.Application")
    Else
        'xlsBook.save    '保存文档
        xlsApp.quit                                                             '关闭excel对象
    End If
    Set xlsBook = xlsApp.Workbooks.Open(xlsPath)                                '打开文件并赋值给xlsbook对象，取得工作簿
    xlsApp.Visible = False                                                      '设置为不可见
    L "已经切换到文档：" & List2.Text
    Label5.Caption = "当前文档：" & List2.Text
    Text1.Enabled = True
    If Me.Visible Then Text1.SetFocus
    Exit Sub
eee:
    L "切换文档错误：" & Err.Number & "->" & Err.Description
End Sub

Private Sub List2_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
    '---------- 当文件拖放到列表框时添加文件的路径和文件名
    Dim i As Long
    For i = 1 To Data.Files.Count '拖放文件的个数
        addToList Trim(Data.Files(i))
    Next i
End Sub
Private Sub addToList(ByVal path$)
    Dim i&
    For i = 0 To List2.ListCount - 1
        If List2.List(i) = path Then
            '文件已经存在列表
            List2.ListIndex = i
            Exit Sub
        End If
    Next
    Dim extname$: extname = mFile.GetFileExtName(path)
    If extname = ".xls" Or extname = ".xlsx" Then
        List2.AddItem path, 0
        Call updateFiles
        L "添加文档：" & path
    End If
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)                                 '文本框的“数据变更”事件
    On Error GoTo eee
    Dim ttt$, hhh$                                                              '定义文本变量，保存和操作语音输入到文本框的内容
    ttt = Trim(Text1.Text)                                                      '从文本框获取数据
    ttt = Replace(ttt, ",", "，")                                               '把英文状态的逗号转成中文状态的，实现不管是中英文逗号都可以触发
    If KeyAscii = 13 Then                                                       '判断，如果文本框内容包含“，”字眼，就执行if代码块
        ttt = Replace(ttt, "，", "")                                            '去掉输入的“，”字眼
        If ttt = "" Then
            L "请不要输入空的内容"
            Text1.Text = ""
            Exit Sub
        End If
        lineNo = lineNo   1                                                     '行号变量递增
        Do Until xlsApp.cells(lineNo, lieNO).Value = ""
            'If xlsApp.cells(lineNo   2, 6).Value = "测       量      者" Then '这三个测量者的字要和表格里的完全一样  空格也要一样
            hhh = xlsApp.cells(lineNo   2, 6).Value
            If hhh Like "*测*" And hhh Like "*量*" And hhh Like "*者*" Then
                endNO = lineNo
                lineNo = lineN   1
                lieNO = lieNO   1
            Else
                lineNo = lineNo   1
            End If
        Loop
        xlsApp.cells(lineNo, lieNO).Value = ttt                                 '定位到单元格（行n，列1）并给当前表格赋值'11是列K
        'If xlsApp.cells(lineNo   2, 6).Value = "测       量      者" Then '这三个测量者的字要和表格里的完全一样  空格也要一样
        hhh = xlsApp.cells(lineNo   2, 6).Value
        If hhh Like "*测*" And hhh Like "*量*" And hhh Like "*者*" Then
            lineNo = lineN
            lieNO = lieNO   1
        End If
        
        xlsBook.save                                                            '保存文档
        xlsChanged = True
        Text1.Text = ""                                                         '清空文本框，等待输入
        Label4.Caption = "上次：" & ttt
        Label6.Caption = "单元格：[ " & lineNo & " 行 " & lieNO & " 列 ]"
        L Label6.Caption & "成功保存数据：" & ttt                               '把结果记录到 list 控件
        Say.Speak "ok", SVSFlagsAsync
        '        Call PlaySound(App.Path & "\sound\Speech On.wav", &H1)                  '读出声音,不需要等声音放完就可直接播放下一个声音
    Else
        ttt = IIf(KeyAscii = 46, "点", Chr(KeyAscii))
        '        Say.Speak ttt, SVSFlagsAsync
        Call PlaySound(App.path & "\sound\Speech On.wav", &H1)
    End If
    
    Exit Sub
eee:
    L "保存数据错误：" & Err.Description
End Sub
Private Sub L(sss)
    Logs sss                                                                    '记录日志到文件，在logs目录下
    List1.AddItem Now() & "-> " & sss, 0
End Sub