在电子邮件正文中复制多个范围 VBA

Question

我的目标是创建一个宏，该宏将复制电子邮件正文中的多个或多个范围。 将粘贴哪个范围将取决于与特定范围关联的单元格是否等于 True。

例如，如果单元格 S11 等于 True，则 range("BO2:O5") 应该是粘贴的范围之一。 或者，如果单元格 S11 和 S13 都等于 true，则应将范围（“BO2：O5”）和范围（“BO6：O10”）粘贴到另一个之上。

我遇到的问题是，例如，如果单元格 S15 等于 True，我的宏也会粘贴所有以前的范围，即使它们在 S 列中的值为 False。

例如：

 S11 = True ->range("BO2:O5")
 S12 = False ->range("BO6:O10")
 S13 = False ->range("BO11:O15")
 S14 = False ->range("BO16:O20")
 S15 = True ->range("B21:O25")
 S16 = False ->range("B26:O30")

我通常只希望粘贴范围（“BO2：O5”）和（“B21：O25”），但我的问题是S15之前的所有范围也将包括在内。

Sub SendEmail()
    Dim doc As Object
    Dim dt As Date
    Dim X
    Dim concatenatedRange As Range
    Dim rangeArray As Variant
    
    dt = Date
    
    ' Create an array of ranges to check
    rangeArray = Array( _
        Sheets("Price Table").Range("B2:O5"), _
        Sheets("Price Table").Range("B6:O9"), _
        Sheets("Price Table").Range("B10:O35"), _
        Sheets("Price Table").Range("B36:O63"), _
        Sheets("Price Table").Range("B64:O93"), _
        Sheets("Price Table").Range("B94:O125"), _
        Sheets("Price Table").Range("B126:O148") _
    )
    
    ' Loop through the ranges and concatenate if the corresponding cell in column S is TRUE
    For i = 11 To 17
        If Range("S" & i).Value = True Then
            If concatenatedRange Is Nothing Then
                Set concatenatedRange = rangeArray(i - 11)
            Else
                Set concatenatedRange = Union(concatenatedRange, rangeArray(i - 11))
            End If
        End If
    Next i
    
    ' Create Outlook email
    With CreateObject("Outlook.Application").CreateItem(0)
        .Body = "Good Morning , " & vbCrLf & vbCrLf & _
            "Please find below the Agricultural Market report for " & dt & " below. If you would like to see some quotations, please do let us know." & vbCrLf
        
        Set doc = .GetInspector.WordEditor
        
        ' Copy the concatenated range if it exists
        If Not concatenatedRange Is Nothing Then
            X = doc.Range.End - 1
            concatenatedRange.Copy
            doc.Range(X).Paste
        End If
        
        .To = "****@****.com;****@****.com"
        .CC = "****@***.com"
        .Subject = "Ags Market Update " & dt
        
        Application.CutCopyMode = 0
        
        .Display 'Change to .Send to send the email immediately
    End With
End Sub

如果您能为我的问题提出任何解决方案，我们将不胜感激！干杯

Answer 1

• 如果

  concatenatedRange

  是不连续的范围对象，例如

  Range("B2:O5, B21:O25")

  ，则将其复制并粘贴到 Excel 中会产生理想的结果。这两个区域（B2:O5、B21:O25）彼此相邻。

• 但是，将其粘贴到其他 Office 应用程序中时，例如

  Word

  ，输出将为

  B2:O25

  。

• 请尝试循环遍历非连续范围对象的每个区域

        If Not concatenatedRange Is Nothing Then
            Dim rArea As Range
            For Each rArea In concatenatedRange.Areas
                X = doc.Range.End - 1
                rArea.Copy
                doc.Range(X).Paste
            Next
        End If