本小程序只适用于,解析TXT文件中保存的发票扫码结果数据!
活不多说!直接上源码:
代码语言：javascript复制''******************************************************************************
''****************更多精彩内容请关注公众号:<VB小源码>***************************
''****************QQ群:344402874 *********************************************
''******************************************************************************
''------------------------------------------------------------------------------
Public C() As String ''数组定义
Public RI As IRibbonUI ''UI事件
Public RC As IRibbonControl ''UI控制
''UI顶级事件
Sub app_load(Ribbon As IRibbonUI)
On Error Resume Next
RI = Ribbon
Ribbon.ActivateTab ("tab_app")
Application.StatusBar = "本程序由<巴西_prince>编写并发布!更多精彩内容请关注公众号:<VB小源码>" ''状态栏
End Sub
(左右滑动查看完整代码)
代码语言：javascript复制
''发票数据解析
Sub FP_DATA(Control As IRibbonControl)
On Error GoTo er
Erase C ''清空数组
FP_CL Control ''清空数据
Dim path As String ''文件路径
path = get_path ''获取文件路径
If path = "false" Then MsgBox "请选择TXT文本文件", vbInformation, "提示": Exit Sub ''判断是否已经选取文件路径
Dim str() As String ''定义文本数组
Open path For Input As #1 ''读取TXT文本
str = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbLf) ''取TXT文本每行数据
Close 1 ''关闭TXT文件
C = str ''赋值给数据C
For I = 0 To UBound(str) ''遍历数组
Dim arr() As String, tmp As String
tmp = str(I) ''取数组中的元素
If tmp <> "" Then ''判断是否为空
arr = Split(tmp, ",") ''分割数组元素数据
Dim J As Integer
J = I 2
With Sheets("工作区") ''操作工作表
.Range("A" & J).Value = J - 1 ''序号
.Range("B" & J).Value = Format(arr(5), "@@@@-@@-@@") ''开票日期
.Range("C" & J).Value = arr(2) ''发票代码
.Range("D" & J).Value = arr(3) ''发票号码
.Range("E" & J).Value = arr(4) ''不含税金额
.Range("G" & J).Value = "=E" & J & "*F" & J ''含税金额
.Range("H" & J).Value = "=E" & J & "*(1 F" & J & ")" ''价税合计
End With
End If
Next
Exit Sub
er: ''错误跳转
MsgBox "发生错误啦!" & vbCrLf & Err.Description, vbCritical, "错误"
End Sub
''关于窗体
Sub FP_GY(Control As IRibbonControl)
On Error Resume Next
UserForm1.Show 1 ''显示关于窗体
End Sub
''获取文件路径
Function get_path() As String
On Error Resume Next
get_path = Application.GetOpenFilename("Text Files (*.txt), *.txt") ''选取文件路径,取消返回false
End Function
(左右滑动查看完整代码)
代码语言：javascript复制
''填充税率
Sub FP_SL(Control As IRibbonControl)
On Error Resume Next
Dim sl As String
slh:
sl = InputBox("请输入税率;" & vbCrLf & "如:16%", "税率输入") ''输入税率
If InStr(sl, "%") > 0 Then ''判断格式
Else
MsgBox "输入格式不正确请重新输入", vbCritical, "警告"
GoTo slh ''格式不正确则跳转提示继续输入
End If
''*******************************
For I = 0 To UBound(C) ''填充税率
Dim tmp As String
tmp = C(I)
If tmp <> "" Then
Dim J As Integer
J = I 2
With Sheets("工作区")
.Range("F" & J).Value = Val(Split(sl, "%")(0)) / 100 ''计算税率
End With
End If
Next
End Sub
''清空和设置单元格格式
Sub FP_CL(Control As IRibbonControl)
With Sheets("工作区")
.Range("A2:H1000").ClearContents ''清空工作区
.Columns("B:D").NumberFormatLocal = "@" ''设置B到D列为文本格式
.Columns("E:E").NumberFormatLocal = "0.00_);[红色](0.00)" ''设置E列为数字格式病保留两位小数点
.Columns("F:F").NumberFormatLocal = "0%" ''设置F列为百分比格式
.Columns("G:H").NumberFormatLocal = "0.00_);[红色](0.00)" ''设置G到H列为数字格式病保留两位小数点
End With
End Sub
(左右滑动查看完整代码)
代码语言：javascript复制第一篇文章的vba工程代码为:vbxym谢谢关注与支持!
