By Aoi Dé Sathairn, 01 Meán Fómhair 2018
Freagraí 0
Is maith 0
tuairimí 2.6K
Vótaí 0
Shuiteáil mé kutools chun cabhrú le tionscadal oibre. Bainistim freisin tuarascáil cuideachta mhór a bhfuil macra ag cruthú ríomhphost ó fhaisnéis a cuireadh isteach. Tá an macra sin stoptha ag obair ar mo ríomhaire. Oibríonn sé ar na ríomhairí nach bhfuil kutools acu. An bhfuil baint ag éinne le rud mar seo roimhe seo? Seo é an macra a oibríonn go breá ar ríomhairí eile:

Fo-phost_Sheet_Outlook_Body()
'Oibriú i Excel 2000-2016
Application.ReferenceStyle = xlA1
Dim rng Mar Raon
Dim OutApp Mar Cuspóir
Dim OutMail Mar Réad
Dim xFillteán Mar Teaghrán
Dim xSht Mar Bhileog Oibre
Dim xSub Mar Teaghrán
Freagra Dim Mar Teaghrán
Dim Msg As Teaghrán
Stíl Dim Mar Teaghrán
Dim Teideal Mar Teaghrán

Socraigh xSht = ActiveSheet
Msg = "An bhfuil tú cinnte gur mian leat an fhoirm seo a sheoladh ar ríomhphost?" ' Sainmhínigh teachtaireacht.
Style = vbYesNo + vbCritical + vbDefaultButton2 ' Sainmhínigh cnaipí.
Title = "Deimhniú seolta ríomhphoist" ' Sainmhínigh teideal.
Response = MsgBox(Msg, Stíl)

Má Freagra = vbYes Ansin
xFolder = Timpeallacht ("USERPROFILE") + "\Desktop\" + "\Foirm Iniúchta Réimse --" + CStr(xSht.Cells(19, "A").Luach) + "--.pdf"
'xSub = "Iniúchadh Réimse don stór" + CStr(xSht.Cells(19, "A").Luach)
Le Feidhmchlár
.EnableEvents = Bréagach
.ScreenUpdating = Bréagach
Deireadh Le

Socraigh rng = Ní dhéanfaidh aon ní
Socraigh rng = ActiveSheet.UsedRange
'Is féidir leat ainm bileog a úsáid freisin
'Socraigh rng = Bileoga ("Do Bhileog").Range Úsáidte

Set OutApp = CreateObject("Outlook.Application")
Socraigh OutMail = OutApp.CreateItem(0)
Dim varCellvalue Chomh fada




Ar Lean Earráid Aghaidh
Le OutMail
.Chun=""
.CC = ""
.BCC = ""
.Subject = "Achoimre"
.Ceangail.Cuir xFillteán leis
.HTMLBody = RangetoHTML(rng)
.Display’ nó úsáid .Display

Deireadh Le
Ar Earráid TéighTo 0

Le Feidhmchlár
.EnableEvents = Fíor
.ScreenUpdating = Fíor
Deireadh Le

Set OutMail = Ní dhéanfaidh aon ní
Socraigh OutApp = Ní dhéanfaidh aon ní
Deireadh Má
Fo Deireadh


Feidhm RangetoHTML(rng Mar Raon)
' Ag obair in Oifig 2000-2016
Dim fso Mar Réad
Dim ts As Object
Dim TempFile Mar Teaghrán
Dim TempWB Mar Leabhar Oibre

TempFile = Timpeallacht$("temp") & "\" & Formáid(Anois, "dd-mm-yy h-mm-ss") & ".htm"

'Cóipeáil an raon agus cruthaigh leabhar oibre nua chun na sonraí a chur isteach
rng.Cóip
Socraigh TempWB = Leabhair Saothair.Cuir(1)
Le TempWB.Sheets(1)
.Cealla(1).PasteSpecial Paste:=8
.Cealla(1).Greamaigh xlPasteSpecialValues ​​, , Bréagach, Bréagach
.Cealla(1).PasteSpecial xlPasteFormats , , Bréagach, Bréagach
.Cealla(1).Roghnaigh
Application.CutCopyMode = Bréagach
Ar Lean Earráid Aghaidh
.DrawingObjects.Visible = Fíor
.DrawingObjects.Scrios
Ar Earráid TéighTo 0
Deireadh Le

'Foilsigh an bhileog go comhad htm
Le TempWB.PublishObjects.Add( _
Cineál Foinse:=xlSourceRange, _
Ainm comhaid:=Comhad Temp, _
Bileog:=TempWB.Sheets(1).Ainm, _
Foinse:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Foilsigh (Fíor)
Deireadh Le

'Léigh na sonraí go léir ón gcomhad htm isteach i RangetoHTML
Socraigh fso = CreateObject ("Scripting.FileSystemObject")
Socraigh ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Dún
RangetoHTML = Ionadaigh(RangetoHTML, "align=center x:foilsitheoireachta=", _
"align=clé x:publissource=")

'Dún TempWB
TempWB.Close savechanges:=Bréagach

'Scrios an comhad htm a d'úsáideamar san fheidhm seo
Maraigh TempFile
Socraigh ts = Ní dhéanfaidh aon ní
Socraigh fso = Ní dhéanfaidh aon ní
Socraigh TempWB = Ní dhéanfaidh aon ní

Feidhm Deireadh
Féach ar an bPost Iomlán