Շաբաթ, Սեպտեմբեր 01 2018
  0 Գրառումներ
  2.7K այցելություններ
0
Քվեարկել
արձակել
Ես տեղադրեցի kutools՝ աշխատանքի համար նախագծում օգնելու համար: Ես նաև ղեկավարում եմ խոշոր ընկերության հաշվետվությունը, որն ունի մուտքագրված տեղեկություններից էլփոստ ստեղծելու մակրո: Այդ մակրոն դադարել է աշխատել իմ համակարգչում։ Այն աշխատում է այն համակարգիչների վրա, որոնք չունեն kutools: Որևէ մեկը նախկինում բախվե՞լ է նման բանի: Ահա մակրո, որը լավ է աշխատում այլ համակարգիչների վրա.

Sub Mail_Sheet_Outlook_Body()
«Աշխատում է Excel-ում 2000-2016 թթ
Application.ReferenceStyle = xlA1
Dim rng As Range
Dim OutApp-ը որպես օբյեկտ
Մթնեցնել OutMail որպես օբյեկտ
Dim xFolder որպես տող
Dim xSht As Worksheet
Dim xSub As String
Dim Response As String
Dim Msg As String
Dim Style As String
Dim Title As String

Սահմանել xSht = ActiveSheet
Msg = «Վստա՞հ եք, որ ցանկանում եք էլփոստով ուղարկել այս ձևը»: Սահմանել հաղորդագրությունը.
Style = vbYesNo + vbCritical + vbDefaultButton2 ' Սահմանել կոճակները:
Title = "Email ուղարկել հաստատում" ' Սահմանել վերնագիրը:
Պատասխան = MsgBox (Msg, Style)

Եթե ​​Պատասխան = vbYes Ապա
xFolder = Environ("USERPROFILE") + "\Desktop\" + "\Field Audit Form--" + CStr(xSht.Cells(19, "A").Value) + "--.pdf"
'xSub = "Դաշտային աուդիտ խանութի համար" + CStr(xSht.Cells(19, "A"). Արժեք)
Դիմումով
.EnableEvents = Սխալ
.ScreenUpdating = Սխալ
Վերջ

Սահմանել rng = Ոչինչ
Սահմանել rng = ActiveSheet.UsedRange
«Դուք կարող եք նաև օգտագործել թերթիկի անվանումը
'Set rng = Sheets ("YourSheet").UsedRange

Set OutApp = CreateObject («Outlook.Application»)
Սահմանել OutMail = OutApp.CreateItem(0)
Dim varCellvalue As Long




Ս.թ. սխալի Ռեզյումե Next
OutMail-ի հետ
Դեպի = ""
.CC = ""
.BCC = ""
.Subject = "Recap"
.Կցորդներ.Ավելացնել xFolder
.HTMLBody = RangetoHTML(rng)
.Ցուցադրել կամ օգտագործել .Ցուցադրել

Վերջ
Սխալի դեպքում GoTo 0

Դիմումով
.EnableEvents = Ճիշտ է
.ScreenUpdating = Ճիշտ է
Վերջ

Սահմանել OutMail = Ոչինչ
Սահմանել OutApp = Ոչինչ
Վերջ: Եթե
Վերջ Sub


Գործառույթ RangetoHTML (rng As Range)
Աշխատում է Office 2000-2016թթ
Dim fso Որպես օբյեկտ
Dim ts As Object
Dim TempFile որպես տող
Dim TempWB-ը որպես աշխատանքային գրքույկ

TempFile = Environ$("temp") & "\" & Format (Այժմ, "dd-mm-yy h-mm-ss") & ".htm"

«Պատճենեք տիրույթը և ստեղծեք նոր աշխատանքային գրքույկ՝ տվյալները մուտքագրելու համար
rng.Պատճենել
Սահմանել 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).Ընտրել
Application.CutCopyMode = Կեղծ է
Ս.թ. սխալի Ռեզյումե Next
.DrawingObjects.Visible = True
.DrawingObjects.Ջնջել
Սխալի դեպքում GoTo 0
Վերջ

«Հրապարակեք թերթիկը htm ֆայլում
TempWB.PublishObjects.Add-ով (_
SourceType:=xlSourceRange, _
Ֆայլի անուն:=TempFile, _
Թերթ:=TempWB.Sheets(1).Անուն, _
Աղբյուրը՝=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
Հրապարակել (Ճշմարիտ)
Վերջ

«Կարդացեք բոլոր տվյալները htm ֆայլից RangetoHTML-ում
Սահմանել fso = CreateObject ("Scripting.FileSystemObject")
Սահմանել ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ց.Փակել
RangetoHTML = Փոխարինել (RangetoHTML, "align=center x:publishsource=", _
«align=left x:publishsource=")

«Փակել TempWB-ն
TempWB.Փակել savechanges:=False

«Ջնջել htm ֆայլը, որն օգտագործել ենք այս գործառույթում
Սպանել TempFile-ը
Սահմանել ts = Ոչինչ
Սահմանել fso = Ոչինչ
Սահմանեք TempWB = Ոչինչ

End գործառույթը
Այս գրառման համար դեռևս պատասխաններ չեն տրվել: