ماکروی ارسال صفحه فعال اکسل توسط ایمیل

یک ماکروی قوی و مفید که در تمام نسخه های اکسل کار می کند و به شما اجازه می دهد که تنها صفحه فعال از فایل اکسل خود را به آدرس دلخواه ایمیل کنید.  

Sub Mail_ActiveSheet()
               Dim FileExtStr As String
               Dim FileFormatNum As Long
               Dim Sourcewb As Workbook
               Dim Destwb As Workbook
               Dim TempFilePath As String
               Dim TempFileName As String
               Dim I As Long
               
               With Application
               .ScreenUpdating = False
               .EnableEvents = False
               End With
               
               Set Sourcewb = ActiveWorkbook
               ActiveSheet.Copy
               Set Destwb = ActiveWorkbook
               With Destwb
               If Val(Application.Version) < 12 Then
               FileExtStr = ".xls": FileFormatNum = -4143
               Else
               If Sourcewb.Name = .Name Then
               With Application
               .ScreenUpdating = True
               .EnableEvents = True
               End With
               MsgBox "Your answer is NO in the security dialog"
               Exit Sub
               Else
               Select Case Sourcewb.FileFormat
               Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
               Case 52:
               If .HasVBProject Then
               FileExtStr = ".xlsm": FileFormatNum = 52
               Else
               FileExtStr = ".xlsx": FileFormatNum = 51
               End If
               Case 56: FileExtStr = ".xls": FileFormatNum = 56
               Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
               End Select
               End If
               End If
               End With
               
               TempFilePath = Environ$("temp") & "\"
               TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
               
               With Destwb
               .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
               On Error Resume Next
               For I = 1 To 3
               .SendMail "", _
               "This is the Subject line"
               If Err.Number = 0 Then Exit For
               Next I
               On Error GoTo 0
               .Close SaveChanges:=False
               End With
               
               With Application
               .ScreenUpdating = True
               .EnableEvents = True
               End With
               End Sub

  توجه کنید که این ماکرو برای ارسال ایمیل ابتدا یک فایل جدید شامل تنها صفحه فعال در محل tempFolder ایجاد کرده و سپس آن را ارسال می کند. برای دانلود فایل حاوی ماکرو به پیوست این مقاله مراجعه کنید