由EXCEL表生成用友导入凭证 , 可以节省凭证录入时间, 提高财务工作效率.下面是导入应收账款凭证的部分VBA代码
Sub yspzdr() '应收款凭证导入
Dim arr1, kh
arr1 = Selection.Value
kh = Array("***", "***", "***", "***") '客户核算时客户名称
kh1 = Array("***", "***", "***", "***") '客户核算时客户编码
bm = Array("***", "***", "***", "***") '部门核算时部门名称
bm1 = Array("***", "***", "***", "***") '部门核算时部门编码
Dim s As String
Dim FullName
Application.ScreenUpdating = False
FullName = VBA.Environ("USERPROFILE") & "\桌面\" & "应收凭证导入.txt"
Open FullName For Output As #1 '以读写方式打开文件，每次写内容都会覆盖原先的内容
s = "凭证输出,V800,001,***有限公司,2010" & Chr(13) '用友软件版本,账套号,公司名称,会计年度
For i = 1 To UBound(arr1) For j = 0 To UBound(kh)
If arr1(i, 2) = kh(j) Then Exit For
Next
For k = 0 To UBound(bm)
If arr1(i, 2) = bm(k) Then Exit For
Next
s = s & Chr(10) & arr1(i, 1) & ",转," & i & ",2," & kh(j) & "摘要,科目代码," & arr1(i, 3) & ",,,,制单人,,,,,,," & kh1(j) & ",," & Chr(13)
If arr1(i, 6) <> "" Then
s = s & Chr(10) & arr1(i, 1) & ",转," & i & ",2," & kh(j) & "摘要,主营业务收入科目代码,," & Round(arr1(i, 7) / 1.17, 2) & "," & arr1(i, 6) & ",,,制单人,,,," & bm1(k) & ",,,,,,," & Chr(13)
End If
'------- （其他代码）
xxse = arr1(i, 4) - Round(arr1(i, 7) / 1.17, 2) '销项税额
s = s & Chr(10) & arr1(i, 1) & ",转," & i & ",2," & kh(j) & "摘要,应交税金科目代码,," & xxse & ",,,,制单人,,,,,,,,,,," & Chr(13)
Next
Print #1, s
Close #1 '关闭文件
MsgBox "数据已导入文本，共" & UBound(arr1) & "个部门！"
Shell ("D:\U8SOFT\ZW\PzInsert.exe") '自动打开用友导入窗口
End Sub
