1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29
| Function range_to_html_sans_codagehtml2(Optional rng As Range) As String
Dim myWebBrowser, wb, i As Long, mesTD As Object, codebase As String, dico, a
Set dico = CreateObject("scripting.dictionary")
codebase = "<html><body><br><div id=""calque"" contenteditable=true style=""width:80%;height:80%;""></div></body></html>" 'code de base avec mon div conteneditable
If rng Is Nothing Then Set rng = Application.InputBox(prompt:="Sample", Type:=8)
Set myWebBrowser = Sheets(1).OLEObjects.Add(ClassType:="Shell.Explorer.2", Left:=1, Top:=1, Width:=700, Height:=800)
myWebBrowser.Activate:
Set wb = myWebBrowser.Object
rng.Copy
With wb
.Silent = True: .Navigate "about:blank": .Document.write codebase: .Document.getelementbyid("calque").Focus
.Document.execcommand "paste", False, Null 'j'execute la commande javascript "Paste"
Set mesTD = .Document.getelementsbytagname("TD") 'je collectionne tout les balises "TD"
For i = 0 To mesTD.Length - 1
'je met toutes les bordures xlnone de la plage en couleur resemblante a celle du xlnone( bleu/grisclair)
If Not mesTD(i).Style.bordertop Like "*pt*" Then mesTD(i).Style.bordertop = "0.5pt solid #A9BCF5"
If Not mesTD(i).Style.borderbottom Like "*pt*" Then mesTD(i).Style.borderbottom = "0.5pt solid #A9BCF5"
If Not mesTD(i).Style.borderleft Like "*pt*" Then mesTD(i).Style.borderleft = "0.5pt solid #A9BCF5"
If Not mesTD(i).Style.borderright Like "*pt*" Then mesTD(i).Style.borderright = "0.5pt solid #A9BCF5"
'If rng.Cells(i + 1).MergeArea.HorizontalAlignment <> 1 Then mesTD(i).Style.textAlign = "center"
Next
range_to_html_sans_codagehtml2 = .Document.getelementbyid("calque").innerhtml 'la fonction devient le string du code html de la plage correspondante
End With
myWebBrowser.Delete
Application.CutCopyMode = False 'on debloque la plage en pointillés (due a copy)
Application.CutCopyMode = True 'on debloque la plage en pointillés (due a copy)
End Function |
Partager