Option Explicit
colle ça dans un module
Sub test()
Dim code, i&, fichier
code = CreateTableBase([A1:E3])
fichier = Environ("userprofile") & "\Desktop\ tablehtmldebase.html"
i = FreeFile
Open fichier For Output As #i
Print #i, code
Close #i
End Sub
Function CreateTableBase(RnG As Range)
' fonction de base de creation de table html sur la base d'une plage de cellule (accepte les fusions )
' patricktoulon
Dim lig&, col&, Cel As Range, AddR$, Doc As Object, Table, TR, TD
Set Doc = CreateObject("htmlfile") ' creation d'un dochtml virtuel(en memoire )(late binding donc sans reference )
Set Table = Doc.createelement("table") 'creation de l'element html table
Doc.body.appendchild (Table) ' on la met dans le body du document virtuel
With Table.Style
'le CSS de la table ici
.Width = Int(RnG.Width) + 1 & "pt" 'largeur
.Height = Int(RnG.Height) + 1 & "pt" 'hauteur
.bordercollapse = "collapse" 'les cellule html seront cote à cote sans espacement
End With
For lig = 1 To RnG.Rows.Count 'boucle sur les lignes de la plage(RnG)
Set TR = Doc.createelement("TR") 'creation d'une ligne dans la table HTML
Table.appendchild (TR) ' on la met dans l'element "Table"
For col = 1 To RnG.Columns.Count ' boucle sur les colonnes de la plage (RnG)
Set Cel = RnG.Cells(lig, col).MergeArea: AddR = Cel.Address(0, 0) 'on determine l'aera de la cellule(lig,col) et son address
If Doc.getelementbyId(AddR) Is Nothing Then ' si L 'element portant l'id(addresse de la cellule.mergearea((ou fusion))) on la crée
Set TD = Doc.createelement("TD") 'creation de la cellule HTML dans la la ligne HTML de la table HTML
TR.appendchild (TD) 'on met la cellule la ligne (balise TR précedemment créée)
With TD
'les attributs ici on peut mettre ce qu'on veux
'exemple .setattribute IndexColonne,cel.column
.ID = AddR ' on lui donne un id correspondant a l'adress de son homologue dans la feuille
.innerhtml = CStr(Cel.Cells(1).Value) ' on lui met le texte de son homologue dans la feuille
.rowspan = Cel.Rows.Count 'fusion de ligne(ne fait rien si il n'y a pas de fusion de ligne)
.colspan = Cel.Columns.Count ' fusion de colonne ( ne fait rien si il n'y a pas de fusion de colonne)
With .Style
'le style de la cellule ici
.Width = Int(Cel.Width) & "pt" 'la largeur de la cellule
.Height = Int(Cel.Height) & "pt" 'la hauteur de la cellule
.Border = "1px solid black" 'pour la demo je met toutes les bordure en noir
End With
End With
End If
Next
Next
CreateTableBase = Doc.body.innerhtml
End Function
)
