Conversion XLS to XML avec Hyperliens vers une autre feuille

Salut,

J'ai un problème sur lequel je suis resté plusieurs heures et auquel mes recherches Google (et mains forums) n'ont pas aboutit clairement :

Je cherche à convertir un fichier XLS en XML. Il faut que je fasse ça par macro dans Excel. Voici mon code :

Sub ExportToXML(cheminFichierXML As String, paramNomFeuille _
 As String)

On Error GoTo ErrorHandler
Dim tablTitresCol() As String
Dim feuilleActive As Worksheet
Dim nomFeuille As String
Dim nbCol As Long, nbLigne As Long
Dim fichierTxt As Integer
Dim Lien As Hyperlink

Set feuilleActive = ThisWorkbook.Worksheets(2)
nomFeuille = feuilleActive.Name
nbCol = feuilleActive.Columns.Count
nbLigne = feuilleActive.Rows.Count
ReDim tablTitresCol(nbCol) As String
fichierTxt = FreeFile
Open cheminFichierXML For Output As #fichierTxt
'Determine titre des colonnes
For i = 0 To nbCol - 1
    If Trim(Cells(1, i + 1).Value) = "" Then Exit For
    tablTitresCol(i) = Cells(1, i + 1).Value
Next i
If i = 0 Then GoTo ErrorHandler
nbCol = i
'Ecriture des balises principales du fichier XML
Print #fichierTxt, "<?xml version=""1.0""?>"
Print #fichierTxt, "<" & nomFeuille & ">"
For U = 2 To nbLigne
If Trim(Cells(U, 1).Value) = "" Then Exit For
Print #fichierTxt, "<" & paramNomFeuille & ">"
    For j = 1 To nbCol
        If Trim(Cells(U, j).Value) <> "" Then
            If Trim(Cells(U, j)) = "See Available Refinements" Then 'Les hyperliens ont tous le meme nom : "See Available..."
                Print #fichierTxt, "<" & tablTitresCol(j - 1) & ">"
                Cells(U, j).Hyperlinks(1).Follow NewWindow:=False
                Dim nbLigneArea As Long, nbColArea As Long
                Set feuilleActive = ThisWorkbook.Worksheets(1)
                nomFeuilleArea = feuilleActive.Name
                nbColArea = feuilleActive.Columns.Count
                nbLigneArea = feuilleActive.Rows.Count
                For A = 3 To nbLigneArea
                If Trim(Cells(A, 1).Value) = "" Then Exit For
                    Print #fichierTxt, "<refinement_name>"
                    Print #fichierTxt, Cells(A, 2).Value
                    Print #fichierTxt, "</refinement_name>"
                    Print #fichierTxt, "<attribute>"
                    Print #fichierTxt, Cells(A, 3).Value
                    Print #fichierTxt, "</attribute>"
                Next A
                Print #fichierTxt, "</" & tablTitresCol(j - 1) & ">"
            Else
                Print #fichierTxt, "<" & tablTitresCol(j - 1) & "><![CDATA[";
                Print #fichierTxt, Cells(U, j).Value;
                Print #fichierTxt, "]]>"
                Print #fichierTxt, "</" & tablTitresCol(j - 1) & ">"
            DoEvents 'OPTIONAL
            End If
        End If
    Next j
    Print #fichierTxt, " </" & paramNomFeuille & ">"
Next U
Print #fichierTxt, "</" & nomFeuille & ">"
ErrorHandler:
If fichierTxt > 0 Then Close #fichierTxt
End Sub

Une difficulté s'ajoute aux simples colonnes et lignes que le fichier XLS contient.

En effet, la dernière colonne contient un hyperlien, pointant vers une plage de cellules dans une autre feuille du classeur excel.

Et il faudrait que j'exploite cette plage en XML, c'est à dire que dans la cellule qui contient l'hyperlien, en XML, il faut que j'ai encore plusieurs sous-balises contenant les colonnes et lignes vers lesquelles cet hyperlien pointe.

Et le hic c'est que je ne trouve pas LA fonction/méthode me permettant d'exploiter cette plage de cellule, comme si c'était un classeur à part entière (pour pouvoir le parcourir avec deux boucles for).

Un vrai calvaire. J'ai essayé le hyperlink(1).Address.Follow qui me semblait le plus logique, mais impossible de pouvoir (par exemple) compter le nombre de colonnes de la plage, et de la définir clairement du style Range(A3:C13).

Merci à l'avance pour votre aide.

Edit : Voici le fichier (auquel j'ai supprimé des milliers de lignes, car il pesait trop lourd, j'ai cependant veillé à ce que au moins un des liens marche)

bonjour,

je ne suis pas sûr d'avoir tout compris.

mais l'instruction suivante te permet de trouver le lien hyperlink rattaché à une cellule.

Sub test()
MsgBox Range("A1").Hyperlinks(1).Address

End Sub

Merci de ta réponse.

J'ai déjà essayé par plusieurs procédés d'afficher l'hyperlien contenu dans ces cases, mais rien n'est retourné.

Là par exemple, le MsgBox est absolument vide.

Je rappelle que ces liens dirigent vers une plage de cellule d'une autre feuille du classeur. Et la seule manière que j'ai trouvé (non pas en VBA) de "visualiser" le lien, c'est de survoler la case et d'attendre la petite bulle qui affiche quelque chose comme C:\...\...\..fhufv.xls - area4514545

Cordialement,

Le paysan

Bonjour,

sur mon fichier cette instruction me retourne bien un lien.

peux-tu mettre un exemple de ton fichier qui ne retourne pas d'adresse pour cette instruction ?

Voici le fichier

Bonjour,

comme le lien fait référence à des cellules dans le même document, tu devras utiliser range("C3").hyperlinks.subaddress

Bonjour,

comme le lien fait référence à des cellules dans le même document, tu devras utiliser range("C3").hyperlinks.subaddress

Cela me renvois une erreur 438, j'ai essayé avec plusieurs syntaxes différentes :

• MsgBox Range("C3").Hyperlinks.SubAdress
• MsgBox Range("C3").Hyperlinks(1).SubAdress
• MsgBox Range("C3").Hyperlinks.subadress
• MsgBox Range("C3").Hyperlinks(1).subadress
• MsgBox Range("C3").Hyperlink.SubAdress
• MsgBox Range("C3").Hyperlink(1).SubAdress
• MsgBox Range("C3").Hyperlink.subadress
• MsgBox Range("C3").Hyperlink(1).subadress

bonjour

essaie subaddress avec 2 d, comme je te l'ai proposé

MsgBox Range("C3").Hyperlinks(1).subaddress

Cela me renvoie un résultat précis, un area !

Merci beaucoup, cela me propulse dans la rédaction de mon code. Il me reste maintenant plus qu'à interpréter cette area pour l'exploiter.

Bonne continuation, je mets le sujet en résolu.