Enregistrer chaque feuilles dans un fichier htm séparé
Voici un module ...
Function tableHTML(plage As Range) As String
tableHTML = "<head><style>table, th, td {border: 1px solid black; border-collapse:collapse;}</style></head><TABLE width=" & plage.Columns.Width & "><TR>"
With plage
For Each colonne In plage.Columns
tableHTML = tableHTML & "<th width=" & colonne.Width & ">" & html(.Cells(1, colonne.Column - .Column + 1)) & "</th>"
Next colonne
If .Rows.Count > 1 Then
For i = 2 To .Rows.Count
tableHTML = tableHTML & "<tr>"
For j = 1 To .Columns.Count
tableHTML = tableHTML & "<td bgcolor=" & DecVersHexa(.Cells(i, j).Interior.Color) & "><font color=" & DecVersHexa(.Cells(i, j).Font.Color) & ">" & html(.Cells(i, j)) & "</font></td>"
Next j
tableHTML = tableHTML & "</tr>"
Next i
End If
End With
tableHTML = tableHTML & "</table>"
End Function
Function DecVersHexa(ByVal valeur As Long) As String
rouge = Left(Hex(Int(valeur Mod 256)) & "00", 2)
vert = Left(Hex(Int((valeur Mod 65536) / 256)) & "00", 2)
bleu = Left(Hex(Int(valeur / 65536)) & "00", 2)
DecVersHexa = rouge & vert & bleu
End Function
Function html(plage As Range)
html = ""
For i = 1 To Len(plage.Value)
deb_style = ""
fin_style = ""
If plage.Characters(Start:=i, Length:=1).Font.Underline <> xlUnderlineStyleNone Then
deb_style = "<u>"
fin_style = "</u>"
End If
If plage.Characters(Start:=i, Length:=1).Font.Bold Then
deb_style = deb_style + "<b>"
fin_style = "</b>" + fin_style
End If
If plage.Characters(Start:=i, Length:=1).Font.Italic Then
deb_style = deb_style + "<i>"
fin_style = "</i>" + fin_style
End If
Select Case Asc(Mid(plage.Value, i, 1))
Case Is = 10
html = html & "<br/>"
Case Is > 127
html = html & deb_style & "&#" & Asc(Mid(plage.Value, i, 1)) & ";" & fin_style
Case Else
html = html & deb_style & Mid(plage.Value, i, 1) & fin_style
End Select
Next
html = Replace(html, "</i><i>", "")
html = Replace(html, "</b><b>", "")
html = Replace(html, "</u><u>", "")
End Functionet un appel que tu peux customiser et sur lequel tu devrais pouvoir itérer avec mac (?)
Sub page()
dossier = "C:\Users\Michel\Downloads"
fichier = "test2html"
feuille = "Feuil1"
Open dossier & "\" & fichier & ".htm" For Output As #1
Print #1, tableHTML(Sheets(feuille).UsedRange)
Close #1
'ShellExecute 0, "open", dossier & "\" & fichier & ".htm", vbNullString, "C:\TEMP\", SW_SHOWNORMAL
End SubBonsoir,
Je ne sais pas comment te remercier, c'est tout simplement génial !
Sub page()
dossier = "/Users/Ludovic/Desktop/PLANNING/"
Dim nomfeuille As String
nomfeuille = ActiveSheet.Name
fichier = "test2html"
feuille = ActiveSheet.Name
Open dossier & nomfeuille & ".htm" For Output As #1
Print #1, tableHTML(Sheets(feuille).UsedRange)
Close #1
'ShellExecute 0, "open", dossier & "\" & fichier & ".htm", vbNullString, "C:\TEMP\", SW_SHOWNORMAL
End SubMa petite modification pour que le nom du fichier htm corresponde automatiquement au nom de la feuille.
Petite question, peut on limiter simplement le nombre de colonne lu sur le tableur ? Si ton module le permet, autrement je supprimerais des informations que je ne souhaite pas qu'elles apparaissent sur le htm.
Merci beaucoup !
Petite question, peut on limiter simplement le nombre de colonne lu sur le tableur ? Si ton module le permet, autrement je supprimerais des informations que je ne souhaite pas qu'elles apparaissent sur le htm.
Pas de problème, la plage est ici
Sheets(feuille).UsedRangemais tu peux mettre ...
Sheets(feuille).range("X9").currentregionpour les cellules contiguës à X9 par exemple
ou
selectionaprès avoir sélectionner une plage
ou
Sheets(feuille).range("D8:Z12")pour la plage D8:Z12 par exemple
La plage que tu veux exporter est définie comme paramètre de la fonction tableHTML
Bonjour,
c'est tout simplement parfait je te remercie infiniment !
Merci pour ce retour ...