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

Popular posts from this blog

html - Firefox flex bug applied to buttons? -

html - Missing border-right in select on Firefox -

python - build a suggestions list using fuzzywuzzy -