Question

我正在尝试让下面的宏在Outlook电子邮件正文中粘贴工作表中的可见单元格。宏工作得很好，唯一的问题是当人们回复电子邮件时，突然所有行都可见。看来，当发送初始电子邮件时，它必须粘贴整个工作表，但保留格式以隐藏已过滤的行，但当人们去回复时，一切都消失了。有什么想法吗？

Sub Send_Range_Or_Whole_Worksheet_with_MailEnvelope()
    'Working in Excel 2002-2013
    Dim AWorksheet As Worksheet
    Dim Sendrng As Range
    Dim rng As Range

    On Error GoTo StopMacro

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Application.DisplayAlerts = False
    End With

    'Fill in the Worksheet/range you want to mail
    'Note: if you use one cell it will send the whole worksheet
    Set Sendrng = Worksheets("APP").Range("A1").SpecialCells(xlCellTypeVisible)

    'Remember the activesheet
    Set AWorksheet = ActiveSheet

    With Sendrng
        ' Select the worksheet with the range you want to send
        .Parent.Select

        'Remember the ActiveCell on that worksheet
        Set rng = ActiveCell

        'Select the range you want to mail
        .Select

        ' Create the mail and send it
        ActiveWorkbook.EnvelopeVisible = True

        With .Parent.MailEnvelope
            ' Set the optional introduction field thats adds
            ' some header text to the email body.
            .Introduction = "Below are the accounts currently falling outside of our High Cash tolerance. Please let us know if any action is needed. Thanks."

            With .Item
                .To = "test@email.com"
                .CC = ""
                .BCC = ""
                .Subject = "APP High Cash"
                .Send
            End With

        End With

        'select the original ActiveCell
        rng.Select
    End With
End Sub

Answer 1

我没有对此进行过测试，但我使用了类似的东西来删除工作表中的隐藏行。如果隐藏了所有行，则此代码将不起作用。

Sub RemoveHiddenRows()
Dim count4, count6 As Double        

    While Range("A" & CStr(count4 + 1)) <> ""
        count4 = count4 + 1
    Wend

    count6 = 1
    While count6 < count4
        DoEvents
        Application.StatusBar = "Deleting hidden rows. " & count6 & " or " & " of "_
        & count4 & " done."
        If Range("A" & CStr(count6)).EntireRow.Hidden = True Then
            Range("A" & CStr(count6)).EntireRow.Delete
        Else
            count6 = count6 + 1
        End If
    Wend
End With

End Sub

宏仅将可见单元格粘贴到电子邮件正文中

1 个答案: