How to convert HTML to Text to cells Microsoft Excel -
i had same problem 1 below:
html text tags formatted text in excel cell
i entered code given answer:
sub sample() dim ie object set ie = createobject("internetexplorer.application") ie .visible = false .navigate "about:blank" .document.body.innerhtml = sheets("sheet1").range("a1").value .document.body.createtextrange.execcommand "copy" activesheet.paste destination:=sheets("sheet1").range("a1") .quit end end sub but got message:
"run-time error '438':
object doesn't support property method"
i new @ using vba on excel , don't know do
i appreciate help
sub excel_to_html_range() dim path string dim rng range path = application.activeworkbook.path & "\book1.htm" set rng = range(cells(1, 1), cells(10, 3)) activeworkbook.publishobjects.add(xlsourcerange, path, "sheet1", _ rng.address, xlhtmlstatic, "name_of_div", "title_of_page") .publish (true) .autorepublish = false end end sub or
sub excel_to_html_workbook() dim path string path = application.activeworkbook.path & "\book1.htm" activeworkbook.saveas filename:=path, fileformat:=xlhtml end sub or use macro
public sub rangetohtm(myrange, docdestination, scaller) ' macro converts excel range html table. ' ' copywrite 1996 - 2011 charles balch, mailto:charlie@balch.edu ' original source @ http://balch.org/charlie/hdoc/exceltohtml.html ' myrange excel range wish convert. ' docdestination filename , path send document to. ' dim lrgb long dim strtitle, mv, cellv, cella, bgc, red, green, blue, sfc1, strcomment, stable string dim rowstart, row, rowcount, rowend, colstart, col, colcount, colend, hza, colspan, ifreefile integer dim sametitle, blniframe, blnboilerplate boolean dim fso filesystemobject dim fpage textstream if instr(docdestination, "iframe_") blniframe = true 'the result optimized use iframe if instr(docdestination, "bp_") blnboilerplate = true 'the result optimized inserting other html documents 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 kill docdestination set fso = new filesystemobject set fpage = fso.createtextfile(docdestination, true, true) if blnboilerplate 'skip header if boilerplate stable = "<table bgcolor=""#ffffff"" border=""1"" align=""center"" >" fpage.writeline "<!-- begin boilerplate " & strtitle & " -->" else fpage.writeline "<!doctype html public ""-//w3c//dtd html 4.01//en"" ""http://www.w3.org/tr/html4/loose.dtd"">" fpage.writeline "<html>" & vbcr fpage.writeline "<head>" & vbcr 'fpage.writeline "<meta http-equiv=""content-type"" content=""text/html;charset=utf-8"">" & vbcr fpage.writeline "<style type=""text/css"">" & vbcr fpage.writeline "body, td, tr, p, h1, h2, h3 { font-family: arial, helvetica, sans-serif; color: #00008b; font-size: 100% }" & vbcr fpage.writeline "a { color: #0000ff }" & vbcr fpage.writeline "a:hover { color: #8f0000}" & vbcr fpage.writeline "</style>" & vbcr strtitle = removehtml(cells(rowstart, colstart)) fpage.writeline "<title>" & strtitle & "</title>" & vbcr ' use first cell title 'note may want use own style sheets or remove sheets entirely if blniframe fpage.writeline "<link rel=""stylesheet"" href=""http://balch.org/iframe.css"" type=""text/css"">" & vbcr else fpage.writeline "<link rel=""stylesheet"" href=""http://balch.org/excel.css"" type=""text/css"">" & vbcr end if fpage.writeline "</head>" & vbcr stable = "<table bgcolor=""#ffffff"" border=""1"" align=""center"" >" if blniframe fpage.writeline "<body >" & vbcr stable = "<table bgcolor=""#ffffff"" border=""1"" align=center width=""100%"" >" & vbcr else fpage.writeline "<body bgcolor=""#9f9f9f"" >" & vbcr end if end if fpage.writeline stable & vbcr while row < rowcount row = row + 1 doevents if (not range(myrange).rows(row).hidden) mv = "" col = 0 while col < colcount col = col + 1 cellv = "" cella = "" if (not range(myrange).columns(col).hidden) 'define cell color lrgb = range(myrange).cells(row, col).interior.color red = hex(lrgb , 255) if len(red) = 1 red = "0" & red green = hex(lrgb \ 256 , 255) if len(green) = 1 green = "0" & green blue = hex(lrgb \ 256 ^ 2 , 255) if len(blue) = 1 blue = "0" & blue bgc = " bgcolor=""#" & red & green & blue & """ " if bgc = " bgcolor=""#ffffff"" " bgc = "" cellv = range(myrange).cells(row, col).text if cellv = "" cellv = "<br />" else 'adjust text if left(cellv, 1) <> "<" cellv = replace(cellv, chr(10), (chr(10) & "<br />")) 'add line feeds unless html 'proposed dan hinz not used looks converts entire cell first hyperlink. ' if range(myrange).cells(row, col).hyperlinks.count = 1 ' cellvh = "<a href=""" & range(myrange).cells(row, col).hyperlinks(1).address & """ target=""newpage"">" ' cellv = cellvh & range(myrange).cells(row, col).text & "</a>" ' end if 'add link home page select case scaller case "awc" cellv = replace(cellv, "charles v. balch phd", "<a href=""http://virgil.azwestern.edu/~cvb"">charles v. balch phd</a>", 1, -1, vbtextcompare) case "cvb" cellv = replace(cellv, "charles v. balch", "<a href=""http://charlie.balch.org"">charles v. balch</a>", 1, -1, vbtextcompare) case "nau" cellv = replace(cellv, "charles v. balch phd", "<a href=""http://oak.ucc.nau.edu/cvb23/"">charles v. balch phd</a>", 1, -1, vbtextcompare) end select 'define cell alignment hza = range(myrange).cells(row, col).horizontalalignment cella = " align=""left"" " if isnumeric(cellv) cella = " align=""right"" " if hza = -4108 cella = " align=""center"" " if hza = -4131 cella = " align=""left"" " if hza = -4152 cella = " align=""right"" " if range(myrange).cells(row, col).font.bold cellv = "<b>" & cellv & "</b>" if range(myrange).cells(row, col).font.italic cellv = "<i>" & cellv & "</i>" cellva = "" vca = range(myrange).cells(row, col).verticalalignment if vca = -4160 cellva = " style=""vertical-align: top"" " if vca = -4107 cellva = " style=""vertical-align: bottom"" " if vca = -4108 cellva = " style=""vertical-align: middle"" " 'define cell font color lrgb = range(myrange).cells(row, col).font.color sfc1 = "" red = hex(lrgb , 255) if len(red) = 1 red = "0" & red green = hex(lrgb \ 256 , 255) if len(green) = 1 green = "0" & green blue = hex(lrgb \ 256 ^ 2 , 255) if len(blue) = 1 blue = "0" & blue sfc1 = "<font color=""#" & red & green & blue & """ > " if sfc1 = "<font color=""#000000"" > " sfc1 = "" sfc2 = "" else sfc2 = "</font>" end if end if 'check merged cells (rows only) if hza = 7 or range(myrange).cells(row, col).mergecells colspan = 0 sametitle = true while (range(myrange).cells(row, col).horizontalalignment = 7 or range(myrange).cells(row, col).mergecells) , sametitle ' following code must changed versions of excel earlier 97 if not range(myrange).columns(col).hidden colspan = colspan + 1 col = col + 1 if len(range(myrange).cells(row, col).text) > 1 or not range(myrange).cells(row, col).mergecells sametitle = false col = col - 1 end if wend if colspan > colcount colspan = colcount cella = cella & " colspan=""" & colspan & """ " end if 'check comment (idea michal matula) scomment = funtestforcomment(range(myrange).cells(row, col)) if scomment <> "" 'the cell not have comment scomment = replace(scomment, chr(34), chr(147)) scomment = " title=""" & scomment & """" cellv = "<a name=""comment"" " & scomment & " >" & cellv & "</a>" end if mv = mv & "<td " & cella & bgc & cellva & ">" & sfc1 & cellv & sfc2 & "</td>" end if wend fpage.writeline "<tr>" & vbcr & mv & vbcr & "</tr>" & vbcr end if wend fpage.writeline "</table>" & vbcr if not blnboilerplate fpage.writeline "</body>" & vbcr fpage.writeline "</html>" & vbcr else fpage.writeline "<!-- end boilerplate -->" end if fpage.close set fpage = nothing set fso = nothing end sub
Comments
Post a Comment