excel - 在多个工作表中选择范围

问题描述

我有一个 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 的初学者，所以我意识到代码中可能存在缺陷 :)

标签： excelvba

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

excel - 在多个工作表中选择范围

问题描述

解决方案

推荐阅读