Struktura logiczna deklaracji VAT7(18) od lipca.
eDeklaracje z Excela do xml.
  strona główna:
A po co ten Excel ;-)
 
 
 
 
 
 
Deklaracja VAT za 7.2018 będziemy składać już w nowej wersji tj. 18. Różnice polegają głównie na dostosowaniu deklaracji do   
split payment'u. Deklaracje VAT7 tworzę za pomocą Excela od lat. Wysyłkę realizuję zaś za pomocą programu eDek.   http://www.e-dek.pl/
Nie potrzebuję zatem drukować deklaracji z Excela a jedynie stworzyć xml'a zgodnego ze strukturą.  
 
Pola i ich warunki ściągam w następujący sposób.   Struktury logiczne
  deklaracji
Sub CzytajXSD()   https://www.finanse.mf.gov.pl/pp/e-deklaracje/struktury-dokumentow-xml
    'Struktury dokumentów XML  
    'https://www.finanse.mf.gov.pl/pp/e-deklaracje/struktury-dokumentow-xml  
 
    Const strURL As String = "http://crd.gov.pl/wzor/2018/05/17/5376/schemat.xsd"   VAT-7D(8)_v1-0E
      
    Dim xsdDoc As Object 'MSXML2.DOMDocument  
    Dim oRoot As Object 'MSXML2.IXMLDOMNode  
    Dim colNodes As Object 'MSXML2.IXMLDOMNodeList  
    Dim oNode As Object 'MSXML2.IXMLDOMNode  
              
      
    Set msXML = CreateObject("Microsoft.xmlHTTP")  
    With msXML  
        .Open "GET", strURL, False  
        .send  
    End With  
      
    Set xsdDoc = CreateObject("MSXML2.DOMDocument")  
    xsdDoc.LoadXML msXML.responseText  
    Set oRoot = xsdDoc.DocumentElement  
    Set colNodes = oRoot.getElementsByTagName("xsd:element")  
              
    Dim i As Long: i = 3  
    With ThisWorkbook.Worksheets("Arkusz1")  
        For Each oNode In colNodes  
            If oNode.Attributes.Item(0).Text Like "P_*" Then  
                .Range("C" & i) = oNode.Attributes.Item(0).Text  
                .Range("D" & i) = oNode.Attributes.Item(1).Text  
                .Range("E" & i) = oNode.nodeTypedValue  
                i = i + 1  
            End If  
        Next  
    End With  
      
    Set oNode = Nothing  
    Set colNodes = Nothing  
    Set xsdDoc = Nothing  
    Set oRoot = Nothing  
    Set msXML = Nothing  
End Sub  
 
 
Po trochu ładniejszym rozmieszczeniu wyników tej procedury otrzymuję Arkusz:  
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
I przykład tworzące e-Deklarację:  
 
 
Sub eDeklaracja_VAT18()  
      
    Const miesiac As Byte = 7  
    Const rok As Integer = 2018  
    Const celZlozenia As Byte = 1  
    Const kodUrzedu As Integer = 1227  
    Const eMail As String = "tkuchta1@gmail.com"  
    Const osFizyczna As Boolean = False  
    Const Nip As String = "7361571236"  
    Const strPelnaNazwa As String = "MiT Kuchta T.Kuchta"  
    Const Regon As String = "369231446"  
 
    Dim strFileName As String  
    strFileName = ThisWorkbook.Path & "\VAT-7(18)_" & _  
                                Format(VBA.DateSerial(rok, miesiac, 1), "yyyy.mm") & _  
                                "_" & Format(Now, "YYYYMMDDhhmm") & ".xml"  
      
    Dim nr As Integer: nr = VBA.FreeFile  
    Open strFileName For Output As #nr  
        Print #nr, "<?xml version=""1.0"" encoding=""UTF-8""?>"  
        Print #nr, "<Deklaracja xmlns=""http://crd.gov.pl/wzor/2018/05/17/5376/"" " & _  
                               "xmlns:etd=""http://crd.gov.pl/xml/schematy/dziedzinowe/mf/2016/01/25/eD/DefinicjeTypy/"">"  
        Print #nr, "<Naglowek>"  
        Print #nr, "   <KodFormularza kodPodatku=""VAT"" " & _  
                                  "kodSystemowy=""VAT-7 (18)"" " & _  
                                  "rodzajZobowiazania=""Z"" " & _  
                                  "wersjaSchemy=""1-0E"">VAT-7</KodFormularza>"  
        Print #nr, "   <WariantFormularza>18</WariantFormularza>"  
        Print #nr, "   <CelZlozenia poz=""P_7"">" & celZlozenia & "</CelZlozenia>"  
        Print #nr, "   <Rok>" & rok & "</Rok>"  
        Print #nr, "   <Miesiac>" & miesiac & "</Miesiac>"  
        Print #nr, "   <KodUrzedu>" & kodUrzedu & "</KodUrzedu>"  
        Print #nr, "</Naglowek>"  
          
        Print #nr, "<Podmiot1 rola=""Podatnik"">"  
        If Not osFizyczna Then  
            Print #nr, "   <OsobaNiefizyczna>"  
            Print #nr, "      <NIP>" & Nip & "</NIP>"  
            Print #nr, "      <PelnaNazwa>" & UT(strPelnaNazwa) & "</PelnaNazwa>"  
            'Print #nr, "      <REGON>" & Regon & "</REGON>"  
            Print #nr, "   </OsobaNiefizyczna>"  
        Else  
            Print #nr, "   <OsobaFizyczna>"  
            Print #nr, "      <NIP></NIP>"  
            Print #nr, "      <ImiePierwsze></ImiePierwsze>"  
            Print #nr, "      <Nazwisko></Nazwisko>"  
            Print #nr, "      <DataUrodzenia></DataUrodzenia>"  
            Print #nr, "   </OsobaFizyczna>"  
        End If  
        Print #nr, "</Podmiot1>"  
 
        With ThisWorkbook.Worksheets("Do Deklaracji")  
            Print #nr, "<PozycjeSzczegolowe>"  
            If .[F4] <> 0 Then Print #nr, "   <P_10>" & L(.[F4]) & "</P_10>"  
            If .[F5] <> 0 Then Print #nr, "   <P_11>" & L(.[F5]) & "</P_11>"  
            If .[F6] <> 0 Then Print #nr, "   <P_12>" & L(.[F6]) & "</P_12>"  
            If .[F7] <> 0 Then Print #nr, "   <P_13>" & L(.[F7]) & "</P_13>"  
            If .[F8] <> 0 Then Print #nr, "   <P_14>" & L(.[F8]) & "</P_14>"  
            If .[F9] <> 0 Then Print #nr, "   <P_15>" & L(.[F9]) & "</P_15>"  
            If .[K9] <> 0 Then Print #nr, "   <P_16>" & L(.[K9]) & "</P_16>"  
            If .[F10] <> 0 Then Print #nr, "   <P_17>" & L(.[F10]) & "</P_17>"  
            If .[K10] <> 0 Then Print #nr, "   <P_18>" & L(.[K10]) & "</P_18>"  
            If .[F11] <> 0 Then Print #nr, "   <P_19>" & L(.[F11]) & "</P_19>"  
            If .[K11] <> 0 Then Print #nr, "   <P_20>" & L(.[K11]) & "</P_20>"  
            If .[F12] <> 0 Then Print #nr, "   <P_21>" & L(.[F12]) & "</P_21>"  
            If .[F13] <> 0 Then Print #nr, "   <P_22>" & L(.[F13]) & "</P_22>"  
            If .[F14] <> 0 Then Print #nr, "   <P_23>" & L(.[F14]) & "</P_23>"  
            If .[K14] <> 0 Then Print #nr, "   <P_24>" & L(.[K14]) & "</P_24>"  
            If .[F15] <> 0 Then Print #nr, "   <P_25>" & L(.[F15]) & "</P_25>"  
            If .[K15] <> 0 Then Print #nr, "   <P_26>" & L(.[K15]) & "</P_26>"  
            If .[F16] <> 0 Then Print #nr, "   <P_27>" & L(.[F16]) & "</P_27>"  
            If .[K16] <> 0 Then Print #nr, "   <P_28>" & L(.[K16]) & "</P_28>"  
            If .[F17] <> 0 Then Print #nr, "   <P_29>" & L(.[F17]) & "</P_29>"  
            If .[K17] <> 0 Then Print #nr, "   <P_30>" & L(.[K17]) & "</P_30>"  
            If .[F18] <> 0 Then Print #nr, "   <P_31>" & L(.[F18]) & "</P_31>"  
            If .[F19] <> 0 Then Print #nr, "   <P_32>" & L(.[F19]) & "</P_32>"  
            If .[K19] <> 0 Then Print #nr, "   <P_33>" & L(.[K19]) & "</P_33>"  
            If .[F20] <> 0 Then Print #nr, "   <P_34>" & L(.[F20]) & "</P_34>"  
            If .[K20] <> 0 Then Print #nr, "   <P_35>" & L(.[K20]) & "</P_35>"  
            If .[K22] <> 0 Then Print #nr, "   <P_36>" & L(.[K22]) & "</P_36>"  
            If .[K23] <> 0 Then Print #nr, "   <P_37>" & L(.[K23]) & "</P_37>"  
            If .[K24] <> 0 Then Print #nr, "   <P_38>" & L(.[K24]) & "</P_38>"  
            If .[K25] <> 0 Then Print #nr, "   <P_39>" & L(.[K25]) & "</P_39>"  
            If .[F27] <> 0 Then Print #nr, "   <P_40>" & L(.[F27]) & "</P_40>"  
            If .[K27] <> 0 Then Print #nr, "   <P_41>" & L(.[K27]) & "</P_41>"  
            'Print #nr, "   <P_42></P_42>"  
            'Print #nr, "   <P_43></P_43>"  
            'Print #nr, "   <P_44></P_44>"  
            'Print #nr, "   <P_45></P_45>"  
            'Print #nr, "   <P_46></P_46>"  
            'Print #nr, "   <P_47></P_47>"  
            'Print #nr, "   <P_48></P_48>"  
            'Print #nr, "   <P_49></P_49>"  
            'Print #nr, "   <P_50></P_50>"  
            Print #nr, "   <P_51>" & L(.[K40]) & "</P_51>"  
            'Print #nr, "   <P_52></P_52>"  
            'Print #nr, "   <P_53></P_53>"  
            Print #nr, "   <P_54>" & L(.[K44]) & "</P_54>"  
            'Print #nr, "   <P_55></P_55>"  
            'Print #nr, "   <P_56></P_56>"  
            'Print #nr, "   <P_57></P_57>"  
            'Print #nr, "   <P_58></P_58>"  
            'Print #nr, "   <P_68></P_68>"  
            'Print #nr, "   <P_59></P_59>"  
            'Print #nr, "   <P_70>2</P_70>"  
            'Print #nr, "   <P_60></P_60>"  
            'Print #nr, "   <P_61></P_61>"  
            'Print #nr, "   <P_69>2</P_69>"  
            'Print #nr, "   <P_62></P_62>"  
            'Print #nr, "   <P_63></P_63>"  
            'Print #nr, "   <P_64></P_64>"  
            'Print #nr, "   <P_65></P_65>"  
            'Print #nr, "   <P_66></P_66>"  
            'Print #nr, "   <P_67></P_67>"  
            Print #nr, "   <P_71>2</P_71>"  
            Print #nr, "   <P_74>" & UT(.[F62]) & "</P_74>"  
            Print #nr, "   <P_75>" & UT(.[F63]) & "</P_75>"  
            Print #nr, "   <P_76>" & DATAA(.[F64]) & "</P_76>"  
        End With  
        Print #nr, "</PozycjeSzczegolowe>"  
        Print #nr, "<Pouczenia>1</Pouczenia>"  
        Print #nr, "</Deklaracja>"  
    Close #nr  
 
    MsgBox " jest: " & strFileName  
      
    XSD_Validation strFileName  
End Sub  
 
Function XSD_Validation(strXMLFilePAth As String) As Boolean  
    Dim xmlDoc As Object 'MSXML2.DOMDocument60  
    Dim objSchemaCache As Object 'New XMLSchemaCache60  
    Dim objErr As Object 'MSXML2.IXMLDOMParseError  
              
    Set objSchemaCache = CreateObject("MSXML2.XMLSchemaCache.6.0")  
    objSchemaCache.Add "http://crd.gov.pl/wzor/2018/05/17/5376/", _  
                       "http://crd.gov.pl/wzor/2018/05/17/5376/schemat.xsd"  
 
    Set xmlDoc = CreateObject("Msxml2.DOMDocument.6.0")  
    With xmlDoc  
        .setProperty "ProhibitDTD", False  
        .async = False  
        .validateOnParse = True  
        .resolveExternals = False  
        .Load strXMLFilePAth  
        Set .Schemas = objSchemaCache  
    End With  
                  
    Set objErr = xmlDoc.Validate()  
    If objErr.ErrorCode = 0 Then  
        MsgBox "Błędów nie znaleziono"  
        XSD_Validation = True  
    Else  
        MsgBox "Error parser: " & objErr.ErrorCode & "; " & objErr.reason  
        Debug.Print objErr.ErrorCode  
        Debug.Print objErr.reason  
    End If  
      
End Function  
 
Function UT(ByVal sStr As String)  
    Dim L As Long, lChar As Long, sUTF8 As String  
    For L = 1 To Len(sStr)  
        lChar = AscW(Mid(sStr, L&, 1))  
        If lChar < 128 Then  
            sUTF8 = sUTF8 + Mid(sStr, L, 1)  
        ElseIf ((lChar > 127) And (lChar < 2048)) Then  
            sUTF8 = sUTF8 + Chr(((lChar \ 64) Or 192))  
            sUTF8 = sUTF8 + Chr(((lChar And 63) Or 128))  
        Else  
            sUTF8 = sUTF8 + Chr(((lChar \ 144) Or 234))  
            sUTF8 = sUTF8 + Chr((((lChar \ 64) And 63) Or 128))  
            sUTF8 = sUTF8 + Chr(((lChar And 63) Or 128))  
        End If  
    Next L&  
    UT = sUTF8  
End Function  
 
Function DATAA(ByVal dat As Date) As String  
    DATAA = Format(dat, "yyyy-mm-dd")  
End Function  
 
Function L(ByVal liczba As Currency) As String  
    L = Replace(liczba, ",", ".")  
End Function  
 
 
 
 
 
 
 
 
 
 
 
 
Walidacja  
 
 
 
 
 
 
 
 
 
 
i efekt: