Lang L: none (table-of-contents)
See kood salvestab töölehe uue töövihikuna ja loob Outlookis meilisõnumi koos uue töövihikuga. See on väga kasulik, kui teil on standardiseeritud malli arvutustabel, mida kasutatakse kogu teie organisatsioonis.
Lihtsama näite saamiseks vaadake artiklit Kuidas saata Excelist e -kirju
Salvestage tööleht uue töövihikuna ja lisage meilile
| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108 | Alampostitööraamat ()Application.DisplayAlerts = ValeApplication.enableevents = ValeApplication.ScreenUpdating = ValeApplication.Calculation = xlCalculationManualDim OutApp objektinaDim OutMail kui objektHämardage FilePath stringinaHämardage projekti_nimi kui stringHämarda malli_nimi stringinaHämarda ülevaade Kuupäev stringinaHämarda Salvesta asukoht stringinaDim tee stringinaDim nimi stringina"Looge esialgsed muutujadSet OutApp = CreateObject ("Outlook.Application")Määra OutMail = OutApp.CreateItem (0)Project_Name = Sheets ("sheet1"). Vahemik ("ProjectName"). VäärtusTemplate_Name = ActiveSheet.Name„Küsige e -posti sisenditReviewDate = InputBox (Prompt: = "Sisestage kuupäev, millal soovite esitamise üle vaadata.", Pealkiri: = "Sisestage kuupäev", Vaikimisi: = "KK/PP/AAAA")Kui ReviewDate = "Sisesta kuupäev" Või ReviewDate = vbNullString, siis mine Go endo„Salvestage tööleht oma töövihikunaPath = ActiveWorkbook.PathNimi = kärpimine (keskmine (ActiveSheet.Name, 4, 99))Määra ws = ActiveSheetSet oldWB = See töövihikSaveLocation = InputBox (Prompt: = "Vali faili nimi ja asukoht", Pealkiri: = "Salvesta kui", Vaikimisi: = CreateObject ("WScript.Shell"). SpecialFolders ("Töölaud") & "/" & Nimi & ". xlsx ")If Dir (SaveLocation) "" SiisMsgBox ("Sellenimeline fail on juba olemas. Palun valige uus nimi või kustutage olemasolev fail.")SaveLocation = InputBox (Prompt: = "Vali faili nimi ja asukoht", Pealkiri: = "Salvesta kui", Vaikimisi: = CreateObject ("WScript.Shell"). SpecialFolders ("Töölaud") & "/" & Nimi & ". xlsx ")Lõpp KuiKui SaveLocation = vbNullString, siis minge endmakro juurdevajadusel eemaldage lehtActiveSheet.Unprotect Password: = "parool"Määra uusWB = töövihikud. Lisa'Reguleerige ekraaniActiveWindow.Zoom = 80ActiveWindow.DisplayGridlines = Vale'Kopeeri + kleebi väärtusioldWB. AktiveerioldWB.ActiveSheet.Cells.SelectValik. KopeerinewWB. AktiveerinewWB.ActiveSheet.Cells.SelectSelection.PasteSpecial Paste: = xlPasteValues, Operation: = xlNone, SkipBlanks _: = Vale, ülevõtmine: = valeSelection.PasteSpecial Paste: = xlPasteFormats, Operation: = xlNone, _SkipBlanks: = vale, ülevõtmine: = valeSelection.PasteSpecial Paste: = xlPasteValidation, Operation: = xlNone, _SkipBlanks: = vale, ülevõtmine: = vale'Valige uus valge valk ja lülitage lõikamisrežiim väljanewWB.ActiveSheet.Range ("A10"). ValigeApplication.CutCopyMode = Vale'Salvesta failnewWB.SaveAs Failinimi: = SaveLocation, _FileFormat: = xlOpenXMLWorkbook, CreateBackup: = ValeFilePath = Application.ActiveWorkbook.FullName„Kaitske vana WB -d uuestioldWB.ActiveSheet.Protect Password: = "password", DrawingObjects: = True, Contents: = True, Scenarios: = True _, AllowFormattingCells: = Tõsi, AllowFormattingColumns: = Tõsi, _AllowFormattingRows: = Tõsi'E -postVea korral Jätka järgmistKoos OutMailiga.to = "[email protected]".CC = "".BCC = "".Subject = Projekti_nimi & ":" & malli_nimi & "ülevaatamiseks".Body = "Projekti nimi:" & Project_Name & "," & Name & "Ülevaatamiseks" & ReviewDate.Attachments.Add (FilePath).Ekraan'. Saada' Valikuline e -kirjade saatmise automatiseerimiseks.LõpetaViga GoTo 0Set OutMail = Mitte midagiSet OutApp = Mitte midagi'Lõpeta makro, taasta ekraani värskendamine, kalkulaatorid jne … lõppmakro:Application.DisplayAlerts = TõsiApplication.enableevents = TõsiApplication.ScreenUpdating = TõsiApplication.Calculation = xlCalculationAutomaticEnd Sub |
