marco pour générer xml

[Lipadec]

Bonjour le Forum et bon début de semaine

Après une longue absence, je reviens vers vous pour vous demander de l'aide
Je voudrai une macro qui pourra me générer un fichier xml suivant un fichier excel défini 2003 ou 2007
sur le fichier excel j'ai:

RAISON SOCIALE
ID_FISCALE
ANNEE
PERIODE(MOIS)
REGIME(ENCAISSEMENT)

puis sur chaque cellule à partir de A, il y a:

ord num des mht tva ttc if nom ice tx id dpai dfac

Le modèle du fichier xml que j'espère avoir sera comme suit

<?xml version="1.0"?>
<DeclarationReleveDeduction xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema">
<identifiantFiscal>----</identifiantFiscal>
<annee>----</annee>
<periode>----</periode>
<regime>----</regime>
<releveDeductions>
<rd>
<ord>----</ord>
<num>----</num>
<des>----</des>
<mht>----</mht>
<tva>----</tva>
<ttc>----</ttc>
<refF>
<if>----</if>
<nom>----</nom>
<ice>----</ice>
</refF>
<tx>----</tx>
<mp>
<id>----</id>
</mp>
<dpai>----</dpai>
<dfac>----</dfac>
</rd>

Merci d'avance pour votre aide

Lipadec

 

[grisan29]

Re : marco pour générer xml

bonjour max_lander, lipatec et le forum

le code du module une fois indenté est plus lisible

Sub GENERER_XML()
    Dim derligne As Integer
    Dim Chemin, Fichier As String
    
    Dim TT_HT, TT_TVA, TT_TTC As Long
    
    derligne = (Range("A" & Rows.Count).End(xlUp).Row) + 1
    
    For Each Cell In Sheets("DEDUC").Range("C1:C" & derligne)
        If Cell.Value = "Total" Then
            TT_HT = Cells(Cell.Row, ((Cell.Column) + 1)).Value
            TT_TVA = Cells(Cell.Row, ((Cell.Column) + 2)).Value
            TT_TTC = TT_HT + TT_TVA
            
            
        End If
    Next
    
    
    
    
'--------------------------------------------
    
    Dim objShell As Object, objFolder As Object, oFolderItem As Object
    
    
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
    
    On Error Resume Next
    Set oFolderItem = objFolder.Items.Item
    Chemin = oFolderItem.Path
    
'-----------------------------------------------------------------------------------------
    
    
    
    Fichier = Chemin & "\FichierGen.xml"
    
    
    Dim intFic As Integer
    intFic = FreeFile
    
    
    Open Fichier For Output As intFic
    
    Print #intFic, "<?xml version="; 1#; "?>"
    Print #intFic, "<DeclarationReleveDeduction xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"">"
    
    
    Print #intFic, "<identifiantFiscal>" & Sheets("DEDUC").Range("C2").Value & "</identifiantFiscal>"
    Print #intFic, "<annee>" & Sheets("DEDUC").Range("C3").Value & "</annee>"
    Print #intFic, "<periode>" & Sheets("DEDUC").Range("C4").Value & "</periode>"
    Print #intFic, "<regime>" & Sheets("DEDUC").Range("C5").Value & "</regime>"
    Print #intFic, "<releveDeductions>"
    
    For Each Cell In Range("A1:A" & derligne)
        If Not IsEmpty(Cell.Value) And IsNumeric(Cell.Value) Then
            
            
            Print #intFic, "<rd>"
            Print #intFic, "<ord>" & Cells(Cell.Row, (Cell.Column)).Value & "</ord>"
            Print #intFic, "<num>" & Cells(Cell.Row, (Cell.Column) + 1).Value & "</num>"
            Print #intFic, "<des>" & Cells(Cell.Row, (Cell.Column) + 2).Value & "</des>"
            Print #intFic, "<mht>" & Cells(Cell.Row, (Cell.Column) + 3).Value & "</mht>"
            Print #intFic, "<tva>" & Cells(Cell.Row, (Cell.Column) + 4).Value & "</tva>"
            Print #intFic, "<ttc>" & Cells(Cell.Row, (Cell.Column) + 5).Value & "</ttc>"
            Print #intFic, "<refF>"
            Print #intFic, "<if>" & Cells(Cell.Row, (Cell.Column) + 6).Value & "</if>"
            Print #intFic, "<nom>" & Cells(Cell.Row, (Cell.Column) + 7).Value & "</nom>"
            Print #intFic, "<ice>" & Cells(Cell.Row, (Cell.Column) + 8).Value & "</ice>"
            Print #intFic, "</refF>"
            Print #intFic, "<tx>" & Cells(Cell.Row, (Cell.Column) + 9).Value& & "</tx>"
            Print #intFic, "<mp>"
            Print #intFic, "<id>" & Cells(Cell.Row, (Cell.Column) + 10).Value & "</id>"
            Print #intFic, "</mp>"
            Print #intFic, "<dpai>" & Cells(Cell.Row, (Cell.Column) + 11).Value & "</dpai>"
            Print #intFic, "<dfac>" & Cells(Cell.Row, (Cell.Column) + 12).Value & "</dfac>"
            Print #intFic, "</rd>"
            
            
        End If
        
    Next
    
    Print #intFic, "<rd>"
    Print #intFic, "<Total Hors taxes>" & TT_HT & "</Total Hors taxes>"
    Print #intFic, "<Total TVA>" & TT_TVA & "</Total TVA>"
    Print #intFic, "<Total TTC>" & TT_TTC & "</Total TTC>"
    Print #intFic, "<rd>"
    
    
    
    
    
    
    Close intFic
    
End Sub

c'est mon coup de griffe a l’excellence de la réponse de max_lander

 

[max.lander]

Re : marco pour générer xml

Salut à tous,

Y a pas photo merci Grisan29,

j'avoue que mon code est un peu taillé à la hache, il y a moyen d'en simplifier une grosse partie : notamment en générant les balises depuis les entêtes de colonnes.

Max,

 

[Lipadec]

Re : marco pour générer xml

Bonjour tout le monde
Merci à vous max.lander et merci au Forum qui nous a permis d'apprendre beaucoup de choses.
La macro marche très bien
Je vais commencer à travailler avec, et si jamais il y a un blocage, je reviendrai vers vous
Merci et bonne fin de journée

 

[grisan29]

Re : marco pour générer xml

bonjour Max-Lander
je ne mis connais pas en codage XML mais pour indenter j'utilise ceci VB Code Indenter c'est par pur hasard que j'ai ouvert le post, peut etre que sous ma signature tu aura réponse

 

[max.lander]

Re : marco pour générer xml

Merci Grisan29

 

[grisan29]

Re : marco pour générer xml

bonjour Max.lander
le lien sous ma signature mène a un forum dédié au html, css et peut etre xml où tu trouverais les réponses a tes interrogations sur le code