由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