Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel Sauvegarde/Export au format HTML ?

Sauvegarde/Export au format HTML ?

2 réponses
Avatar
NICO
Bonjour,

Cela à l'air si simple, mais je n'y arrive point !

J'aimerais savoir s'il est possible de sauvegarder bêtement une feuille au
format HTML avec une fonction 'SaveAs' ?

Le but étant ensuite de récupérer ensuite le corps de cette page HTML dans
un mail pour l'envoyer via Excel.

Merci.

NICO.


--
Using Opera's revolutionary e-mail client: http://www.opera.com/m2/
Signaler un problème avec ce contenu

2 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Gaenonius
Il faut passer par une macro spécifique. En voici une qui est un "classique" du
genre, et qui peut servir de base à des besoins personnalisés (attention aux
retours à la ligne mal placés par les lecteur de courriels):

'''''''''''''''''''''''
Sub RangeToHTM(MyRange, DocDestination)
' This macro will convert an Excel range to a HTML Table.
'
' Copywrite 1996 - 2000 by Charles Balch, mailto:
' Original Source is at http://balch.org/charlie/hdoc
'
' Care Ware! The code is yours to use and adapt for free as long as
' you do something nice for anyone (that includes you).
' Please send me Email describing how you use this code and any
' adjustments that you have made. Redistribute at will.
' Please leave my name and the original source in the comments.
'
' MyRange is an Excel range you wish to convert.
' DocDestination is the FileName and Path to send the document to.
'
Application.StatusBar = "Please be patient..."
CalcState = Application.Calculation
StatusBarState = Application.DisplayStatusBar
Application.Calculation = xlManual
Calculate
RowStart = Range(MyRange).Row
ColStart = Range(MyRange).Column
ColCount = Range(MyRange).Columns.Count
RowCount = Range(MyRange).Rows.Count
RowEnd = RowStart + RowCount - 1
ColEnd = ColStart + ColCount - 1
If Len(Dir(DocDestination)) > 1 Then Kill DocDestination
Open DocDestination For Output As 1
'create Code
Print #1, "<HTML>" & Chr$(13)
Print #1, "<HEAD>" & Chr$(13)
'Establish Font in all areas
Print #1, "<STYLE TYPE=""text/css"">" & Chr$(13)
Print #1, "<!-- " & Chr$(13)
Print #1, "BODY, TD, TR, P, H1, H2, H3 { font-family: arial,
helvetica, sans-serif; COLOR=""#00008B""; font-size: 100% }" & Chr$(13)
Print #1, "A { COLOR=""0000FF"" }" & Chr$(13)
Print #1, "A:hover { Color: #8F0000}" & Chr$(13)
Print #1, " -->" & Chr$(13)
Print #1, "</STYLE>" & Chr$(13)
MyTitle = Cells(RowStart, ColStart) ' Use first cell as title
Print #1, "<TITLE>" & MyTitle & "</TITLE>" & Chr$(13)
Print #1, "</HEAD>" & Chr$(13)
Print #1, "<BODY bgcolor=" & Chr(34) & "#9F9F9F" & Chr(34) & " >" &
Chr$(13)
Print #1, "<FONT FACE=""arial, helvetica, sans-serif"">" & Chr$(13)
Print #1, "<CENTER><TABLE bgcolor=" & Chr(34) & "#FFFFFF" & Chr(34) & "
Border=2>" & Chr$(13)
'Print #1, "<Caption><B><Font Size=+2>" & MyTitle & "<Font
Size=-2></B></caption>" & Chr$(13)
While Row < RowCount
Row = Row + 1
DoEvents
Application.StatusBar = DocDestination & ": " & Str$(Int((Row /
RowCount) * 100)) & "% Completed"
If (Not Range(MyRange).Rows(Row).Hidden) Then
MV = ""
Col = 0
While Col < ColCount
Col = Col + 1
CellV = ""
If (Not Range(MyRange).Columns(Col).Hidden) Then
strTemp = Range(MyRange).Cells(Row, Col).Text
For intP = 1 To Len(strTemp)
strCC = Mid(strTemp, intP, 1)
If Asc(strCC) = 10 Then strCC = "<BR>"
CellV = CellV & strCC
Next intP
If CellV = "" Then CellV = "<BR>"
HzA = Range(MyRange).Cells(Row, Col).HorizontalAlignment
CellA = " Align=Right "
If HzA = -4108 Then CellA = " AlignÎnter "
If HzA = -4131 Then CellA = " Align=Left "
If HzA = -4152 Then CellA = " Align=Right "
If Range(MyRange).Cells(Row, Col).Font.Bold Then CellV
= "<B>" & CellV & "</B>"
If Range(MyRange).Cells(Row, Col).Font.Italic Then
CellV = "<I>" & CellV & "</I>"
If HzA = 7 Or Range(MyRange).Cells(Row, Col).MergeCells
Then
ColSpan = 0
SameTitle = True
While (Range(MyRange).Cells(Row,
Col).HorizontalAlignment = 7 Or Range(MyRange).Cells(Row, Col).MergeCells) And
SameTitle
' The following code must be changed for
versions of Excel earlier than 97
If Not Range(MyRange).Columns(Col).Hidden Then
ColSpan = ColSpan + 1
Col = Col + 1
If (Len(Range(MyRange).Cells(Row, Col).Text) >
1 Or Range(MyRange).Cells(Row, Col).MergeCells = False) Then SameTitle = False:
Col = Col - 1
Wend
CellA = CellA & " ColSpan=" & ColSpan
End If
'find cell interior color
CC = Range(MyRange).Cells(Row, Col).Interior.ColorIndex
BGC = ""
If CC = 1 Then BGC = "#000000" 'black"
If CC = 3 Or CC = 22 Then BGC = "#FFD0D0" 'Red"
If CC = 4 Or CC = 35 Then BGC = "#CCFFCC" 'green"
If CC = 6 Or CC = 19 Then BGC = "#FFFFCC" 'yellow"
If CC = 8 Or CC = 41 Or CC = 34 Or CC = 20 Then BGC =
"#CCFFFF" 'blue
If CC = 9 Then BGC = "#8A0045" 'burgandy
If CC = 15 Or CC = 40 Then BGC = "#DFDED0" 'grey"
If CC = 39 Or CC = 24 Or CC = 39 Then BGC = "#FFCCFF"
'Purple
If Len(BGC) > 2 Then BGC = " bgcolor=" & Chr(34) & BGC
& Chr(34)

'find cell font color
FC = Range(MyRange).Cells(Row, Col).Font.ColorIndex
SFC1 = ""
SFC2 = ""
If FC = 3 Then
SFC1 = "<FONT COLOR=""#FF0000"">"
ElseIf FC = 2 Then
SFC1 = "<FONT COLOR=""#FFFFFF"">"
End If
If Len(SFC1) > 2 Then SFC2 = "</FONT>"
'Replace chr(13) with <BR>
'Range(MyRange).Cells(Row, Col).Replace

MV = MV & "<TD" & CellA & BGC & ">" & SFC1 & CellV &
SFC2 & "</TD>"
End If
Wend
Print #1, "<TR>" & MV & "</TR>" & Chr$(13)
End If
Wend
Print #1, "</TABLE></CENTER></BODY>" & Chr$(13)
Print #1, "<P>" & Chr$(13)
Print #1, "This table was created by a free Excel macro written by <A
HREF =" & Chr(34) & "MAILTO:" & Chr(34) & ">Charles
Balch</A>.<BR>" & Chr$(13)
Print #1, "Here's the <A HREF = " & Chr(34) &
"http://charlie.balch.org/hdoc/exceltohtml.html" & Chr(34) & ">code</A>. It is
care ware - it's yours for free if do something nice for anyone (anyone includes
you)."
Print #1, "</HTML>" & Chr$(13)
Close
DoEvents
Application.Calculation = CalcState
Application.StatusBar = ""
Application.DisplayStatusBar = StatusBarState
End Sub

Sub MakeandSendHTM()
' This macro makes a HTML document then sends it to a web site.
' The macro uses WS_FTP Pro but with little change WS_FTP Light would work
' to send the document. WS_FTP can be found at http://www.tucows.com.
'
' I assume that you have created the c:FTPSend Directory locally
' and that you have a /hdoc
'
' Written by Charles Balch.
' Public Domain 1998-2000. Copyright. All rights reserved.
'
'Information for local Document
DefaultFile = LCase(ActiveSheet.Name & ".html") 'Use sheet name for document name
MyFile = InputBox("What File Name?", "Assign File Name", DefaultFile)
LocalDestination = "C:FTPSend" & MyFile
If Len(MyFile) < 2 Then End

'Create document
DoEvents
Names.Add Name:="FastHTMLExport", RefersTo:=Selection
Call RangeToHTM("FastHTMLExport", LocalDestination)

'Establish Destination
DoEvents
FTPDestination = "/hdoc/" & MyFile
FTPServer = "http://balch.org"

'See if this document is for the CIS area
If Left(ActiveWorkbook.Name, 3) = "cis" Then
FTPDestination = "/CIS/class/" & MyFile
End If

FTPDestination = InputBox("Send file to: ", "Make & Send", FTPDestination)

'Copy Destination Path into Clipboard (for pasting into docs)
DoEvents
Dim Clip As DataObject
Set Clip = New DataObject
Clip.SetText (FTPServer & FTPDestination)
Clip.PutInClipboard

'Send Document
If FTPDestination <> "" Then
FTPprogram = "C:Program FilesWS_FTP Proftp95pro.exe "
FTPAction = FTPprogram & "local:" & LCase(LocalDestination) & "
Balch:d:/inetpub/balch" & FTPDestination
DoEvents
MyShellResult = Shell(FTPAction, 1)
End If

End Sub
'''''''''''''''''''''''

--
Gaenonius

Bonjour,

Cela à l'air si simple, mais je n'y arrive point !

J'aimerais savoir s'il est possible de sauvegarder bêtement une feuille
au format HTML avec une fonction 'SaveAs' ?

Le but étant ensuite de récupérer ensuite le corps de cette page HTML
dans un mail pour l'envoyer via Excel.

Merci.

NICO.




Avatar
Michel Pierron
Bonjour Nico;
As-tu essayé simplement:
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs "C:MonFichier.htm", xlHtml
Application.DisplayAlerts = True

MP

"NICO" a écrit dans le message de
news:
Bonjour,

Cela à l'air si simple, mais je n'y arrive point !

J'aimerais savoir s'il est possible de sauvegarder bêtement une feuille au
format HTML avec une fonction 'SaveAs' ?

Le but étant ensuite de récupérer ensuite le corps de cette page HTML dans
un mail pour l'envoyer via Excel.

Merci.

NICO.


--
Using Opera's revolutionary e-mail client: http://www.opera.com/m2/