By Guest ar ddydd Sadwrn, 01 Medi 2018
atebion 0
hoff bethau 0
barn 2.6K
Pleidleisiau 0
Gosodais kutools i gynorthwyo gyda phrosiect ar gyfer gwaith. Rwyf hefyd yn rheoli adroddiad cwmni mawr sydd â macro yn creu e-bost o wybodaeth a gofnodwyd. Mae'r macro hwnnw wedi rhoi'r gorau i weithio ar fy nghyfrifiadur. Mae'n gweithio ar y cyfrifiaduron nad oes ganddynt kutools. Oes rhywun wedi rhedeg i mewn i rywbeth fel hyn o'r blaen? Dyma'r macro sy'n gweithio'n iawn ar gyfrifiaduron eraill:

Is-Bost_Sheet_Outlook_Body()
'Gweithio yn Excel 2000-2016
Application.ReferenceStyle = xlA1
Dim rng Fel Ystod
Dim OutApp Fel Gwrthrych
Dim OutMail Fel Gwrthrych
Dim xFolder Fel Llinyn
Dim xSht Fel Taflen Waith
Dim xSub Fel Llinyn
Dim Ymateb Fel Llinyn
Dim Msg Fel Llinyn
Arddull Dim Fel Llinyn
Dim Teitl Fel Llinynnol

Gosod xSht = ActiveSheet
Msg = "Ydych chi'n siŵr eich bod am e-bostio'r ffurflen hon?" ' Diffinio neges.
Arddull = vbYesNo + vbCritical + vbDefaultButton2 ' Diffinio botymau.
Title = "E-bost wedi'i anfon cadarnhad" ' Diffinio teitl.
Ymateb = MsgBox(Msg, Arddull)

Os Ymateb = vbYes Yna
xFolder = Amgylchedd ("USERPROFILE") + "\Desktop\" + "\Ffurflen Archwilio Maes--" + CStr(xSht.Cells(19, "A").Value) + "--.pdf"
' xSub = "Archwiliad Maes ar gyfer storfa" + CStr(xSht.Cells(19, "A").Value)
Gyda Cais
.EnableEvents = Gau
.ScreenUpdating = Gau
Diwedd Gyda

Gosod rng = Dim byd
Gosod rng = ActiveSheet.UsedRange
'Gallwch hefyd ddefnyddio enw dalen
'Gosod rng = Sheets("Eich Dalen").UsedRange

Set OutApp = CreateObject ("Outlook.Application")
Gosod OutMail = OutApp.CreateItem(0)
Dim varCellvalue Cyhyd




Ar Ail-ddechrau Gwall Nesaf
Gydag OutMail
.i=""
.CC = ""
.BCC = ""
.Subject = "Adolygu"
.Atodiadau.Ychwanegu xFfolder
.HTMLBody = RangetoHTML(rng)
.Display' neu ddefnyddio .Display

Diwedd Gyda
Ar Gwall Ewch i 0

Gyda Cais
.EnableEvents = Gwir
.ScreenUpdating = Gwir
Diwedd Gyda

Set OutMail = Dim byd
Gosod OutApp = Dim byd
Gorffennwch Os
Is-End


Swyddogaeth RangetoHTML(rng Fel Ystod)
' Gweithio yn Office 2000-2016
Dim fso Fel Gwrthrych
Dim ts Fel Gwrthrych
Dim TempFile Fel Llinynnol
Dim TempWB Fel Gweithlyfr

TempFile = Amgylchedd$("temp") & "\"&Fformat(Nawr, "dd-mm-yy h-mm-ss") & ".htm"

'Copïwch yr ystod a chreu llyfr gwaith newydd i basio'r data ynddo
rng.Copi
Gosod TempWB = Llyfrau Gwaith.Ychwanegu(1)
Gyda TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).Gludo Gwerthoedd xlPaste Arbennig , , Anghywir, Anghywir
.Cells(1).Gludo Fformatau xlPaste Arbennig , , Gau, Anghywir
.Celloedd(1).Dewiswch
Application.CutCopyMode = Anghywir
Ar Ail-ddechrau Gwall Nesaf
.DrawingObjects.Visible = Gwir
.DrawingObjects.Dileu
Ar Gwall Ewch i 0
Diwedd Gyda

'Cyhoeddwch y ddalen i ffeil htm
Gyda TempWB.PublishObjects.Add( _
Math Ffynhonnell:=xlSourceRange, _
Enw ffeil:=Ffeil Temp, _
Dalen:=TempWB.Sheets(1).Enw, _
Ffynhonnell:=TempWB.Sheets(1).UsedRange.Address, _
Math Html:=xlHtmlStatic)
.Cyhoeddi (Gwir)
Diwedd Gyda

'Darllenwch yr holl ddata o'r ffeil htm i RangetoHTML
Gosod fso = CreateObject ("Scripting.FileSystemObject")
Gosod ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Close
RangetoHTML = Amnewid(RangetoHTML, "align=center x:publishsource=", _
"align=chwith x:publishsource=")

' TempWB agos
TempWB.Close savechanges:=Gau

'Dileu'r ffeil htm a ddefnyddiwyd gennym yn y ffwythiant hwn
Lladd TempFile
Gosod ts = Dim byd
Gosod fso = Dim byd
Gosod TempWB = Dim byd

Swyddogaeth End
Gweld y Post Llawn