Tartalomjegyzék
Ez a kód új munkafüzetként menti el a munkalapot, és létrehoz egy e -mailt az Outlook -ban az új munkafüzettel együtt. Nagyon hasznos, ha van egy szabványosított sablon táblázat, amelyet az egész szervezetben használnak.
Egyszerűbb példaért tekintse meg az E -mail küldése az Excelből című témakört
Mentse a munkalapot új munkafüzetként, és csatolja az e -mailhez
| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108 | Allevelezési_ munkafüzet ()Application.DisplayAlerts = HamisApplication.enableevents = HamisApplication.ScreenUpdating = HamisApplication.Calculation = xlCalculationManualDim OutApp objektumkéntDim OutMail objektumkéntFájlpálya halványítása karakterlánckéntDim Project_Name mint karakterláncHalvány sablon_név karakterlánckéntDátum karakterlánckéntDim mentési hely karakterlánckéntHalvány útvonal karakterlánckéntHalvány név karakterláncként'Kezdeti változók létrehozásaSet OutApp = CreateObject ("Outlook.Application")Set OutMail = OutApp.CreateItem (0)Project_Name = Táblázatok ("sheet1"). Tartomány ("ProjectName"). ÉrtékTemplate_Name = ActiveSheet.Name"Kérje az e -mailben használt bemenetetReviewDate = InputBox (Prompt: = "Adja meg a dátumot, ameddig szeretné ellenőrizni a beküldést.", Cím: = "Adja meg a dátumot", Alapértelmezett: = "HH/NN/ÉÉÉÉ")Ha ReviewDate = "Adja meg a dátumot" Vagy ReviewDate = vbNullString Akkor GoTo endmacro'Mentse el a munkalapot saját munkafüzetkéntÚtvonal = ActiveWorkbook.PathNév = Vágás (Közép (ActiveSheet.Name, 4, 99))Állítsa be ws = ActiveSheetSet oldWB = ThisWorkbookSaveLocation = InputBox (Prompt: = "Fájlnév és hely kiválasztása", Cím: = "Mentés másként", Alapértelmezett: = CreateObject ("WScript.Shell"). SpecialFolders ("Asztal") & "/" & Név & ". xlsx ")Ha Dir (SaveLocation) "" AkkorMsgBox ("Egy ilyen nevű fájl már létezik. Kérjük, válasszon új nevet vagy törölje a meglévő fájlt.")SaveLocation = InputBox (Prompt: = "Fájlnév és hely kiválasztása", Cím: = "Mentés másként", Alapértelmezett: = CreateObject ("WScript.Shell"). SpecialFolders ("Asztal") & "/" & Név & ". xlsx ")Vége HaHa SaveLocation = vbNullString Akkor GoTo endmacro'ha szükséges, távolítsa el a lapotActiveSheet.Unprotect Password: = "jelszó"NewWB = Munkafüzetek beállítása'Állítsa be a kijelzőtActiveWindow.Zoom = 80ActiveWindow.DisplayGridlines = Hamis'Értékek másolása + beillesztéseoldWB. AktiválásoldWB.ActiveSheet.Cells.SelectKiválasztás. MásolásnewWB. AktiválásnewWB.ActiveSheet.Cells.SelectSelection.PasteSpecial Paste: = xlPasteValues, Operation: = xlNone, SkipBlanks _: = Hamis, transzponálás: = hamisSelection.PasteSpecial Paste: = xlPasteFormats, Operation: = xlNone, _SkipBlanks: = Hamis, Transzponál: = HamisSelection.PasteSpecial Paste: = xlPasteValidation, Operation: = xlNone, _SkipBlanks: = Hamis, Transzponál: = Hamis'Válasszon új fehéregyensúlyt, és kapcsolja ki a vágási módotnewWB.ActiveSheet.Range ("A10"). Válassza kiApplication.CutCopyMode = Hamis'Fájl mentésenewWB.SaveAs Fájlnév: = SaveLocation, _FileFormat: = xlOpenXMLWorkbook, CreateBackup: = HamisFilePath = Application.ActiveWorkbook.FullName'Védje meg az oldWB -toldWB.ActiveSheet.Protect Jelszó: = "jelszó", DrawingObjects: = Igaz, Tartalom: = Igaz, Forgatókönyvek: = Igaz _, AllowFormattingCells: = Igaz, AllowFormattingColumns: = Igaz, _AllowFormattingRows: = Igaz'EmailHiba esetén Folytassa a következőtAz OutMail segítségével.to = "[email protected]".CC = "".BCC = "".Subject = Project_Name & ":" & Template_Name & "for review".Body = "Projekt neve:" & Project_Name & "," & Name & "A" & ReviewDate felülvizsgálatára.Attachments.Add (FilePath).Kijelző'.Küldés' Opcionális az e -mailek küldésének automatizálásához.Vége ezzelGoTo 0 hiba eseténSet OutMail = SemmiSet OutApp = Semmi'Makró befejezése, Képernyőfrissítés visszaállítása, Calcs stb … endmacro:Application.DisplayAlerts = IgazApplication.enableevents = IgazApplication.ScreenUpdating = IgazApplication.Calculation = xlCalculationAutomaticEnd Sub |
