原创-VBA金税盘开票XML生成
Option Explicit
Public Type SE
S As Integer
E As Integer
End Type
''''''''''''''''''''''''''''''''''''''''''''''''
''''''''取得客户编码.txt文件总行数''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''
Function GetLine(ByVal TargetFile As String) As Integer
Dim m As Integer
Dim NextLine As String
Open TargetFile For Input As #1
Do Until EOF(1)
Line Input #1, NextLine
m = m + 1
Loop
Close #1
GetLine = m
End Function
''''''''''''''''''''''''''''''''''''''''''''''''
''''开始RGB(0, 255, 0)，结束RGB(255, 0, 0)''''''
''''''''''''''''''''''''''''''''''''''''''''''''
Function GetSE() As SE
Dim j As Integer
Dim LastRow As Integer
LastRow = Application.CountA(Sheets(1).Range("F:F"))
For j = 1 To LastRow
If Sheets(1).Cells(j, 6).Font.Color = RGB(0, 255, 0) Then GetSE.S = j
If Sheets(1).Cells(j, 6).Font.Color = RGB(255, 0, 0) Then GetSE.E = j
Next
If GetSE.E = 0 Then GetSE.E = GetSE.S
End Function
Sub Inv2Xml()
Dim Line, TotalRow As Integer
Dim i, l, k, z, y As Integer
''''''''''''''''''''''''''''''''''''''''''''''''
'金税盘导出的客户编码，TXT格式，默认为逗号分隔符
''''''''''''''''''''''''''''''''''''''''''''''''
Const TargetFile As String = "C:\Users\Administrator\Desktop\客户编码.txt"
Application.ScreenUpdating = False
Line = GetLine(TargetFile)
ReDim Arr_Line(Line - 1) '获取客户编码
i = 1
Open TargetFile For Input As #1
Do While Not EOF(1)
Line Input #1, Arr_Line(i - 1)
i = i + 1
Loop
Close #1
Sheets(2).Select
Cells.Delete
Cells(1, 1) = "编码,名称,简码,税号,地址,电话,银行,账号,邮件地址,备注,身份证校验"
For k = 1 To Line - 3
Cells(k + 1, 1).Value = Arr_Line(k + 2)
Next k
''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''简单的分列''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''
Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2), Array(5, 2), Array(6, 2), _
Array(7, 2), Array(8, 2), Array(9, 2)), TrailingMinusNumbers:=True
Columns("F:F").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("H:H").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("E:E").TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 2), Array(2, 2)), TrailingMinusNumbers:=True
Columns("G:G").TextToColumns Destination:=Range("G1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 2), Array(2, 2)), TrailingMinusNumbers:=True
Range("E1").Value = "地址"
Range("F1").Value = "电话"
Range("G1").Value = "银行"
Range("H1").Value = "账号"
Range("A:A,C:C,I:I,J:J,K:K,L:L,M:M").Delete Shift:=xlToLeft
TotalRow = Application.CountA(Sheets(2).Range("A:A"))
''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''建立字典'''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''
Static Tin As New Scripting.Dictionary
Static Addr As New Scripting.Dictionary
Static Tel As New Scripting.Dictionary
Static Bank As New Scripting.Dictionary
Static Acc As New Scripting.Dictionary
For l = 2 To TotalRow
Tin(Cells(l, 1).Value) = Cells(l, 2).Value
Addr(Cells(l, 1).Value) = Cells(l, 3).Value
Tel(Cells(l, 1).Value) = Cells(l, 4).Value
Bank(Cells(l, 1).Value) = Cells(l, 5).Value
Acc(Cells(l, 1).Value) = Cells(l, 6).Value
Next
''''''''''''''''''''''''''''''''''''''''''''''''
'''''检查开票资料完整性，不完整则退出模块'''''''
''''''''''''''''''''''''''''''''''''''''''''''''
Sheets(3).Select '如果没有3个sheet会下标超限出错
Cells.Delete
Call GetSE
z = 0
For y = GetSE.S To GetSE.E
If Not Tin.Exists(Sheets(1).Cells(y, 7).Value) Then
z = z + 1
Sheets(3).Cells(z, 1).Value = Sheets(1).Cells(y, 7).Value
End If
Next
If z <> 0 Then
Exit Sub
Else
End If
Dim InvFile As String
If Dir("d:\xml\Inv2Xml\", vbDirectory) <> "" Then
Else: MkDir "d:\xml\Inv2Xml\"
End If
InvFile = "d:\xml\Inv2Xml\" & "InvoiceModel_" & Format(Date, "YYYYMMDD") & "_" & Sheets(1).Cells(GetSE.S, 6) & "~" & Sheets(1).Cells(GetSE.E, 6) & ".xml"
''''''''''''''''''''''''''''''''''''''''''''''''
Dim Inv As DOMDocument60 'xml文档
Dim Ver As IXMLDOMProcessingInstruction '进程指令
Dim Arr_Inv As Variant '定义数组
Dim Counter_FpLine As Integer '发票计数器
'''''''''''''''''根节点'''''''''''''''''''''''''
Dim N_Kp As IXMLDOMElement '开票
'''''''''''''''''一级节点'''''''''''''''''''''''
Dim N_Version As IXMLDOMElement '版本，有此节点，则表示用带分类编码
Dim N_Fpxx As IXMLDOMElement '发票信息
'''''''''''''''''二级节点'''''''''''''''''''''''
Dim N_Zsl As IXMLDOMElement '总数量
Dim N_Fpsj As IXMLDOMElement '发票数据
'''''''''''''''''三级节点'''''''''''''''''''''''
Dim N_Fp As IXMLDOMElement '发票
'''''''''''''''''四级节点'''''''''''''''''''''''
Dim N_Djh As IXMLDOMElement '单据号，20字节
Dim N_Gfmc As IXMLDOMElement '购方名称，100字节
Dim N_Gfsh As IXMLDOMElement '购方税号，100字节
Dim N_Gfyhzh As IXMLDOMElement '购方银行账号，100字节
Dim N_Gfdzdh As IXMLDOMElement '购方地址电话，100字节
Dim N_Bz As IXMLDOMElement '备注，240字节
Dim N_Fhr As IXMLDOMElement '复核人，8字节
Dim N_Skr As IXMLDOMElement '收款人，8字节
Dim N_Spbmbbh As IXMLDOMElement '商品编码版本号，20字节，必输项
Dim N_Hsbz As IXMLDOMElement '含税标志：含税标志0：不含税税率，1：含税税率，2：差额税;中外合作油气田（原海洋石油）5%税率、1.5%税率为1，差额税为2，其他为0；
Dim N_Spxx As IXMLDOMElement '商品信息
''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''五级节点'''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''
Dim N_Sph As IXMLDOMElement '商品行
''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''六级节点'''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''
Dim N_Xh As IXMLDOMElement '序号
Dim N_Spmc As IXMLDOMElement '商品名称，100字节，金额为负数时此行是折扣行，折扣行的商品名称应与上一行的商品名称一致
Dim N_Ggxh As IXMLDOMElement '规格型号，40字节
Dim N_Jldw As IXMLDOMElement '计量单位，32字节
Dim N_Spbm As IXMLDOMElement '商品编码，19字节，必输项
Dim N_Syyhzcbz As IXMLDOMElement '使用优惠政策标识，1字节，是否使用优惠政策标识0：不使用，1：使用
Dim N_Qyspbm As IXMLDOMElement '企业商品编码，20字节
Dim N_Lslbz As IXMLDOMElement '零税率标志，1字节，零税率标识空：非零税率，0：出口退税，1：免税，2：不征收，3普通零税率
Dim N_Yhzcsm As IXMLDOMElement '优惠政策说明
Dim N_Dj As IXMLDOMElement '单价，为不含税单价（中外合作油气田（原海洋石油）5%税率，单价为含税单价）
Dim N_Sl As IXMLDOMElement '数量
Dim N_Je As IXMLDOMElement '金额，当金额为负数时为折扣行，为不含税金额
Dim N_Slv As IXMLDOMElement '税率
Dim N_Kce As IXMLDOMElement '扣除额，用于差额税计算
''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''常量赋值'''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''
Const Review As String = "陈琴"
Const Payee As String = "乐雪梅"
Const Code_Version As String = "14.0"
Const Hs_Code As String = "1010202010000000000"
Const R_Unit As String = "立方米"
Const Corp_Code As String = "002"
Const Crude_Wood As String = "原木"
''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''生成根节点'''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''
Set Inv = New MSXML2.DOMDocument60
Set N_Kp = Inv.createElement("Kp")
Set Inv.DocumentElement = N_Kp
''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''生成一级节点'''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''
Set N_Version = Inv.createNode(NODE_ELEMENT, "Version", "")
N_Version.Text = "2.0"
Set N_Fpxx = Inv.createNode(NODE_ELEMENT, "Fpxx", "")
N_Kp.appendChild N_Version
N_Kp.appendChild N_Fpxx
''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''生成二级节点'''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''
Set N_Zsl = Inv.createNode(NODE_ELEMENT, "Zsl", "")
Set N_Fpsj = Inv.createNode(NODE_ELEMENT, "Fpsj", "")
N_Fpxx.appendChild N_Zsl
N_Fpxx.appendChild N_Fpsj
''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''循环生成三级节点'''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''
Counter_FpLine = 0
Arr_Inv = Sheets(1).Range("A" & (GetSE.S - 1) & ":S" & GetSE.E)
For i = 2 To UBound(Arr_Inv)
If Arr_Inv(i, 6) <> Arr_Inv((i - 1), 6) Then
Counter_FpLine = Counter_FpLine + 1
Set N_Fp = Inv.createNode(NODE_ELEMENT, "Fp", "")
''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''循环生成四级节点'''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''
Set N_Djh = Inv.createNode(NODE_ELEMENT, "Djh", "")
Set N_Gfmc = Inv.createNode(NODE_ELEMENT, "Gfmc", "")
Set N_Gfsh = Inv.createNode(NODE_ELEMENT, "Gfsh", "")
Set N_Gfyhzh = Inv.createNode(NODE_ELEMENT, "Gfyhzh", "")
Set N_Gfdzdh = Inv.createNode(NODE_ELEMENT, "Gfdzdh", "")
Set N_Bz = Inv.createNode(NODE_ELEMENT, "Bz", "")
Set N_Fhr = Inv.createNode(NODE_ELEMENT, "Fhr", "")
Set N_Skr = Inv.createNode(NODE_ELEMENT, "Skr", "")
Set N_Spbmbbh = Inv.createNode(NODE_ELEMENT, "Spbmbbh", "")
Set N_Hsbz = Inv.createNode(NODE_ELEMENT, "Hsbz", "")
Set N_Spxx = Inv.createNode(NODE_ELEMENT, "Spxx", "")
N_Djh.Text = Arr_Inv(i, 6)
N_Gfmc.Text = Arr_Inv(i, 7)
N_Gfsh.Text = Tin(Arr_Inv(i, 7))
N_Gfyhzh.Text = Bank(Arr_Inv(i, 7)) & " " & Acc(Arr_Inv(i, 7))
N_Gfdzdh.Text = Addr(Arr_Inv(i, 7)) & " " & Tel(Arr_Inv(i, 7))
N_Fhr.Text = Review
N_Skr.Text = Payee
N_Spbmbbh.Text = Code_Version
N_Hsbz.Text = "0"
N_Fp.appendChild N_Djh
N_Fp.appendChild N_Gfmc
N_Fp.appendChild N_Gfsh
N_Fp.appendChild N_Gfyhzh
N_Fp.appendChild N_Gfdzdh
N_Fp.appendChild N_Bz
N_Fp.appendChild N_Fhr
N_Fp.appendChild N_Skr
N_Fp.appendChild N_Spbmbbh
N_Fp.appendChild N_Hsbz
N_Fp.appendChild N_Spxx
N_Fpsj.appendChild N_Fp
End If
''''''''''''''''''''''''''''''''''''''''''''''''
Set N_Xh = Inv.createNode(NODE_ELEMENT, "Xh", "")
Set N_Spmc = Inv.createNode(NODE_ELEMENT, "Spmc", "")
Set N_Ggxh = Inv.createNode(NODE_ELEMENT, "Ggxh", "")
Set N_Jldw = Inv.createNode(NODE_ELEMENT, "Jldw", "")
Set N_Spbm = Inv.createNode(NODE_ELEMENT, "Spbm", "")
Set N_Syyhzcbz = Inv.createNode(NODE_ELEMENT, "Syyhzcbz", "")
Set N_Qyspbm = Inv.createNode(NODE_ELEMENT, "Qyspbm", "")
Set N_Lslbz = Inv.createNode(NODE_ELEMENT, "Lslbz", "")
Set N_Yhzcsm = Inv.createNode(NODE_ELEMENT, "Yhzcsm", "")
Set N_Dj = Inv.createNode(NODE_ELEMENT, "Dj", "")
Set N_Sl = Inv.createNode(NODE_ELEMENT, "Sl", "")
Set N_Je = Inv.createNode(NODE_ELEMENT, "Je", "")
Set N_Slv = Inv.createNode(NODE_ELEMENT, "Slv", "")
Set N_Kce = Inv.createNode(NODE_ELEMENT, "Kce", "")
N_Xh.Text = Arr_Inv(i, 2)
N_Spmc.Text = Crude_Wood
N_Jldw.Text = R_Unit
N_Spbm.Text = Hs_Code
N_Qyspbm.Text = Corp_Code
N_Dj.Text = Arr_Inv(i, 10)
N_Sl.Text = Arr_Inv(i, 9)
N_Je.Text = Arr_Inv(i, 12)
N_Slv.Text = Arr_Inv(i, 13)
''''''''''''''''''''''''''''''''''''''''''''''''
Set N_Sph = Inv.createNode(NODE_ELEMENT, "Sph", "")
N_Sph.appendChild N_Xh
N_Sph.appendChild N_Spmc
N_Sph.appendChild N_Ggxh
N_Sph.appendChild N_Jldw
N_Sph.appendChild N_Spbm
N_Sph.appendChild N_Syyhzcbz
N_Sph.appendChild N_Qyspbm
N_Sph.appendChild N_Lslbz
N_Sph.appendChild N_Yhzcsm
N_Sph.appendChild N_Dj
N_Sph.appendChild N_Sl
N_Sph.appendChild N_Je
N_Sph.appendChild N_Slv
N_Sph.appendChild N_Kce
''''''''''''''''''''''''''''''''''''''''''''''''
Inv.getElementsByTagName("Spxx").Item(Counter_FpLine - 1).appendChild N_Sph
If Arr_Inv(i, 6) <> Arr_Inv((i - 1), 6) Then
Inv.getElementsByTagName("Bz").Item(Counter_FpLine - 1).Text = Arr_Inv(i, 5)
Else
Inv.getElementsByTagName("Bz").Item(Counter_FpLine - 1).Text = Inv.getElementsByTagName("Bz").Item(Counter_FpLine - 1).Text & vbCrLf & Arr_Inv(i, 5)
End If
Next
N_Zsl.Text = Inv.getElementsByTagName("Fp").Length
''''''''''''''''''''''''''''''''''''''''''''''''
Set Ver = Inv.createProcessingInstruction("xml", "version='1.0' encoding='GBK'")
Call Inv.insertBefore(Ver, Inv.childNodes(0))
Inv.Save InvFile
''''''''''''''''''''''''''''''''''''''''''''''''
Tin.RemoveAll
Addr.RemoveAll
Tel.RemoveAll
Bank.RemoveAll
Acc.RemoveAll
Set Tin = Nothing
Set Addr = Nothing
Set Tel = Nothing
Set Bank = Nothing
Set Acc = Nothing
Set Inv = Nothing
Set N_Kp = Nothing
Set N_Version = Nothing
Set N_Fpxx = Nothing
Set N_Zsl = Nothing
Set N_Fpsj = Nothing
Set N_Fp = Nothing
Set N_Djh = Nothing
Set N_Gfmc = Nothing
Set N_Gfsh = Nothing
Set N_Gfyhzh = Nothing
Set N_Gfdzdh = Nothing
Set N_Bz = Nothing
Set N_Fhr = Nothing
Set N_Skr = Nothing
Set N_Spbmbbh = Nothing
Set N_Hsbz = Nothing
Set N_Spxx = Nothing
Set N_Sph = Nothing
Set N_Xh = Nothing
Set N_Spmc = Nothing
Set N_Ggxh = Nothing
Set N_Jldw = Nothing
Set N_Spbm = Nothing
Set N_Syyhzcbz = Nothing
Set N_Qyspbm = Nothing
Set N_Lslbz = Nothing
Set N_Yhzcsm = Nothing
Set N_Dj = Nothing
Set N_Sl = Nothing
Set N_Je = Nothing
Set N_Slv = Nothing
Set N_Kce = Nothing
Application.ScreenUpdating = True
End Sub
原创-VBA金税盘开票XML生成相关推荐
- csv格式用什么打开可以编辑_如何用EXCEL/WPS整理航信版（金税盘/白盘）客户（商品）编码表...
企业开票人员在使用金税盘开票软件,客户编码保存或者自动保存的越来越多就很混乱,那么如何快速的把客户编码整理好呢? 本文就以WPS为例教大家整理客户编码. 1. 导出客户编码 依次点击:系统设置 - 客 ...
- 金税盘怎么安装在电脑上_金税盘处于锁死期不能开票怎么办？
金税盘俗称白盘是从国税局购买,配合开票软件,进行开具发票的一种税控设备.企业使用金税盘开具发票的时候,如果出现某些操作或使用上的问题,就会无法开具发票,比如,金税盘处于锁死期,那遇到这种情况怎么办?下 ...
- 【航天信息开票软件V3.0金税盘版安装恢复过程】有坑有心得
@[TOC]航天信息开票软件V3.0金税盘版安装恢复过程 2023年5月11日 昨天下午我司财务打开"开票软件V3.0"提示更新,但是更新过程中出现错误.再启动 开票软件V3.0 ...
- 税收分类编码2020_增值税开票系统你会吗？2020最新开票（金税盘版）图文教程详细版...
做会计的都或多或少的涉及到增值税,增值税也算是我们税务里面占比比较大的,那么增值税发票怎么开?增值税开票软件怎么操作?你都会吗?你曾经会是不是都忘记了? 今天会计君和大家分享一份完整的增值税发票开票软 ...
- 金税盘怎么安装在电脑上_金税盘怎么安装，电脑重装后怎样安装金税盘税控开票软件？...
金税盘是税务部门为了报税方便而进化出来的一个系统.通过金税盘可以开票.抄税.清卡.领购发票.金税盘使用增值税防伪税控系统,可开具增值税专用发票和增值税普通发票,一般的企业或个体商铺纳税人需要用到.第一 ...
- 软件更新｜增值税发票税控开票软件（金税盘版_V2.051ZS_20221031)
公开 FWSK(KP)_ V2.0.51_ZS_20221031 综合说明 一．补丁下发说明 版本号 V2.0.51 补丁编号 FWSK(KP)_ V2.0.51_ZS_20221031 系统 名称 ...
- Menu详解（二）：利用XML生成菜单和子菜单
前言:上篇,我们说了有关代码生成菜单和子菜单的方法,这里我们再讲讲有关利用XML生成菜单和子菜单的问题. 业精于勤,荒于嬉,行成于思,毁于随 (日拱一卒) 系列文章: 1.<Menu详解(一): ...
- 《金税盘--发票开具、发票领购、发票安全存储、发票管理、身份认证和抄报税功能详解》
<金税盘–发票开具.发票领购.发票安全存储.发票管理.身份认证和抄报税功能详解> 安装启动 出施设置 编码管理 发票读入 开具发票 抄报税 本视频将会对六大类分别进行介绍,本视频来源于网络 ...
- 织梦html地图插件,织梦dede网站地图xml生成插件（图文教程）
织梦网站地图xml生成插件描述 1.utf8 和 gbk 有齐2种编码插件文件 2.根据自己程序编码选择对应插件,上传模块,安装,使用 3.可同时生成5种地图文件 sitemap.html site ...
最新文章
- linux编程 fmemopen函数打开一个内存流 使用FILE指针进行读写访问
- jsp中的basePath和path (绝对路径 相对路径)
- CMake 使用笔记
- PyTorch 系列 | 数据加载和预处理教程
- 操作系统概述 记录操作系统相关知识
- spoj839 Optimal Marks（最小割，dinic）
- python的作者为什么要创造python_为什么要学习Python？老男孩Python开发
- Linux内存管理：memblock（引导期间管理内存区域）
- 火星时代室内效果图风暴10CD B
- 需要管理员权限才能删除文件夹
- jquery ztree 皮肤（官网介绍）
- C语言实现推箱子游戏
- deepstream视频数据流分析工具包安装使用教程
- java的h2是什么_什么是H2数据库
- OpenCV——透视变换
- 数显电接点压力表与指针电接点压力表的区别
- Gatekeeper代码导读
- ORACLE OGG同步时更新分区字段值的问题
- python字符串的定界符可以是_Python中，字符串不能用以下哪个符号作为定界符（）: \|'|'''|;...
- 阿里大鱼：自自定短信模板