Question

我有一个Excel请求表单，在其中填写工作表并单击“发送”按钮后，将选择某些单元格，然后以文本形式通过电子邮件发送。

Private Sub AutoSend()

    'THIS CHECKS THAT ALL PINK CELLS ARE COMPLETED
    Dim cell As Range
    Dim bIsEmpty As Boolean
    bIsEmpty = False
    For Each cell In Range("B6:B9,B11:B13")
        If IsEmpty(cell) = True Then
            bIsEmpty = True
            Exit For
        End If
    Next cell
    'THIS DISPLAYS AN ERROR MESSAGE IF ONE OR MORE PINK CELLS ARE NOT FILLED OUT
    If bIsEmpty = True Then
        MsgBox "Please fill out EACH CELL highlighted in pink."
        Exit Sub
    End If
    'THIS DISPLAYS AN ERROR MESSAGE IF CUSTOMER ANSWERS "NO" TO BOTH "IS FULL MAILBOX ACCESS REQUESTED?" AND "IS SEND AS ACCESS REQUESTED"
    If (Range("B11").Value = "No" And Range("B12").Value = "No") Then
        MsgBox "You have answered 'no' to both questions in the 'Type of Access' section. You need to answer 'yes' to at least one question in order to proceed."
        Exit Sub
    End If
    'THIS STARTS SENDING THE REQUEST TO THE TEAM IF ALL IS FILLED OUT PROPERLY
    If MsgBox("Are you sure you want to proceed?", vbYesNo) = vbNo Then Exit Sub
    AutoSend_Notification.StartUpPosition = 0
    AutoSend_Notification.Left = Application.Left + (0.5 * Application.Width) - (0.5 * AutoSend_Notification.Width)
    AutoSend_Notification.Top = Application.Top + (0.5 * Application.Height) - (0.5 * AutoSend_Notification.Height)
    AutoSend_Notification.Show
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object

    'Only the visible cells in the selection
    Sheet4.Unprotect ("XY4lZ6n0ElvCmQ!r")

    Set rng = Sheet4.Range("A1:C2,A5:B13").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

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

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = "xxx@yyy.com"
        .CC = ""
        .BCC = ""
        .Subject = "" & Sheet4.Range("A1").Value
        .HTMLBody = RangetoHTML(rng)
        .Send   'or use .Display
    End With
    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing

    msg = MsgBox("Thank you! Your request has been submitted. Within a few moments you will receive an e-mail with a ticket number to confirm that we have received your request. This form will be automatically closed now.", vbInformation)
    'END EMAIL SCRIPT
    Application.DisplayAlerts = False
    ActiveWorkbook.Close
    Application.DisplayAlerts = True
    Exit Sub
End Sub

我主要关注这段代码：

    Sheet4.Unprotect ("XY4lZ6n0ElvCmQ!r")
    Set rng = Sheet4.Range("A1:C2,A5:B13").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

如您所见，以上代码仅在Sheet4中复制单元格。我需要做的是在“ xlSheetVeryHidden” Sheet1（Sheet1.Range（“ A1：D1”））中再添加一个范围。

我尝试了Union函数，但是遇到了错误：

    Sheet4.Unprotect ("XY4lZ6n0ElvCmQ!r")
    Sheet1.Unprotect ("XY4lZ6n0ElvCmQ!r")

    Dim r1, r2, myMultipleRange As Range
    Set r1 = Sheet4.Range("A1:C2,A5:B13").SpecialCells(xlCellTypeVisible)
    Set r2 = Sheet1.Range("A1:D1")
    Set myMultipleRange = ApXL.Union(r1, r2)
    On Error GoTo 0

我尝试了AND函数，但也遇到了错误：

    Sheet4.Unprotect ("4F4lZ6n0ElvCmQ!r")
    Sheet1.Unprotect ("4F4lZ6n0ElvCmQ!r")

    Set rng = Sheet4.Range("A1:C2,A5:B13").SpecialCells(xlCellTypeVisible) And Sheet1.Range("A1:D1")
    On Error GoTo 0

所以，我的问题是，如何将Sheet1.Range（“ A1：D1”）范围添加到以下代码中，以便将Sheet4和Sheet1范围都复制到自动发送的电子邮件中？

Sheet4.Unprotect ("XY4lZ6n0ElvCmQ!r")
Set rng = Sheet4.Range("A1:C2,A5:B13").SpecialCells(xlCellTypeVisible)
On Error GoTo 0

我尝试在此处搜索主题，但是找不到特别适合该问题的内容，因此如果我忽略了任何内容，我们深表歉意。

还请注意，我是VBA的初学者，所以我意识到代码中可能存在缺陷：）

Answer 1

如果要在Excel中的不同工作表中编写文本，可能的一个好主意是将它们写到单独的工作表中并从该工作表中进行引用。您必须提出一些业务逻辑，以避免数据重叠。例如start always from the last used cell。

否则，如@SJR的第一条评论所述，来自两个不同工作表的联合会引发错误，如下所示：

Sub TestMe()

    Dim a As Range
    Dim b As Range
    Dim c As Range

    Set a = Worksheets(1).Range("A1:A10")
    Set b = Worksheets(2).Range("A1:B100")

    Set c = Union(a, b) 'Would be a 1004 error!  

End Sub

在多张纸中选择范围

1 个答案: