excel - VBA: Why when I paste cells in a email using VBA does it remove some conditional formatting? -
what want able copy , paste cells spread sheet email conditional formatting applied. example, have following cells:
b c 1 name: sales: percentage 2 dave grohl 3 80% 3 kurt cobain 6 40% 4 pat smear 7 66% 5 freddie mercury 2 25% 6 roger taylor 8 95% 7 brian may 1 74% 8 taylor hawkins 0 32% 9 noel gallagher 9 63% 10 michael jackson 8 30% 11 whitney houston 2 82%
and there conditional formatting on column b (sales
) > 5 green , <= 5 red , conditional formatting on column c (percentage
) >50% green , <= 50% red, happens keeps values removes of formatting, e.g. removes chosen font on data not headings , removes color of sales
column not percentage
column.
the code using follows:
sub emailextract() dim objoutlook object dim objmail object dim tempfilepath string dim location string dim individual string dim rng range set objoutlook = createobject("outlook.application") set objmail = objoutlook.createitem(0) worksheets("contacts").activate range("a2").select while activecell <> "" activecell.offset(1, 0).select location = activecell.address individual = activecell.value worksheets("individual output 2").activate range("c2").value = individual set rng = activesheet.range("a1:m28").rows.specialcells(xlcelltypevisible) if rng nothing msgbox "the selection not range or sheet protected" & _ vbnewline & "please correct , try again.", vbokonly exit sub end if objmail .to = "joe.bloggs@hotmail.com" .subject = "" dim greeting string if time >= #12:00:00 pm# greeting = "afternoon ," else greeting = "morning," end if .htmlbody = "<font face=arial><p>" & "good " + greeting + "</p>" .htmlbody = .htmlbody + "<p>" & "please find below " & monthname((month(date)) - 1) & " information." & "</p>" .htmlbody = .htmlbody + rangetohtml(rng) .htmlbody = .htmlbody + "<p>" & "kind regards" & "</p>" .htmlbody = .htmlbody + "<p>" & "joe bloggs" & "</p></font>" .display end worksheets("contacts").activate wend set objoutlook = nothing set objmail = nothing set objoutlook = nothing set objmail = nothing end sub function rangetohtml(rng range) dim fso object dim ts object dim tempfile string dim tempwb workbook tempfile = environ$("temp") & "\" & format(now, "dd-mm-yy h-mm-ss") & ".htm" 'copy range , create new workbook past data in rng.copy set tempwb = workbooks.add(1) tempwb.sheets(1) .cells(1).pastespecial paste:=8 .cells(1).pastespecial xlpastevalues, , false, false .cells(1).pastespecial xlpasteformats, , false, false .cells(1).select application.cutcopymode = false on error resume next .drawingobjects.visible = true .drawingobjects.delete on error goto 0 end 'publish sheet htm file tempwb.publishobjects.add( _ sourcetype:=xlsourcerange, _ filename:=tempfile, _ sheet:=tempwb.sheets(1).name, _ source:=tempwb.sheets(1).usedrange.address, _ htmltype:=xlhtmlstatic) .publish (true) end 'read data htm file rangetohtml set fso = createobject("scripting.filesystemobject") set ts = fso.getfile(tempfile).openastextstream(1, -2) rangetohtml = ts.readall ts.close rangetohtml = replace(rangetohtml, "align=center x:publishsource=", _ "align=left x:publishsource=") 'close tempwb tempwb.close savechanges:=false 'delete htm file used in function kill tempfile set ts = nothing set fso = nothing set tempwb = nothing end function
i have tried changing following:
set tempwb = workbooks.add(1) tempwb.sheets(1) .cells(1).pastespecial paste:=8 .cells(1).pastespecial xlpastevalues, , false, false .cells(1).pastespecial xlpasteformats, , false, false .cells(1).select application.cutcopymode = false on error resume next .drawingobjects.visible = true .drawingobjects.delete on error goto 0 end
to:
set tempwb = workbooks.add(1) tempwb.sheets(1) .cells(1).pastespecial application.cutcopymode = false on error resume next .drawingobjects.visible = true .drawingobjects.delete on error goto 0 end
and to:
set tempwb = workbooks.add(1) tempwb.sheets(1) rng.copy destination:=.cells(1) .cells(1).select on error resume next .drawingobjects.visible = true .drawingobjects.delete on error goto 0 end
but neither of them have worked.
can please help?
i've found out problem how can round it:
the conditional formatting applied on workbook a, code copy range workbook workbook b, on workbook of conditional formatting calculated using data on other sheets within workbook a, when copied on conditional formatting cells using data in other sheets no longer formatted because links break. need work in way copies conditional formatting, removes conditional formatting keeps colors, copies , pastes cells workbook b, reapplies conditional formatting in workbook next time. ideas?
i tried create html code of table using excel formula , pasted in html document... works pretty (of course, if formatting pretty simple explain)....
providing table on a1 cnnn
for header line, type example in e1 cell
="<tr><th>"&a1&"</th><th>"&b1&"</th><th>"&c1&"</th></tr>"
and line 2 of data in e2
="<tr><td>"&trim(a2)&"</td><td bgcolor=" & if(b2<5;"red";"green") & ">" & b2 &"</td><td bgcolor=" & if(c2>50%;"green";"red") & ">" & text(c2;"0%") & "</td></tr>"
and copy /past formula rows data. encapsulate generated code between table tags
<table>...</table>
and html code table can paste in .htmlbody of email....
Comments
Post a Comment