【发布时间】:2021-09-03 10:37:50
【问题描述】:
我正在尝试使用 For/If/Else 根据某个单元格是否不为空来返回各种范围,然后将该范围粘贴到电子邮件中。
下面的代码返回范围 B15:G20,无论有问题的单元格 (b20) 是否为空。理想情况下,我想测试最多四个单元格,看看它们是否不为空,并返回一个仅包含包含数据的单元格的范围。
Sub EXPVendorCopyRangeToOutlook_single()
'Declare Outlook Vairables
Dim oLookApp As Outlook.Application
Dim oLookItm As Outlook.MailItem
Dim oLookIns As Outlook.Inspector
'Declare Word Vaiables
Dim oWrdDoc As Word.Document
Dim oWrdRng As Word.Range
'Declare Excel Variables
Dim ExcRng As Range
On Error Resume Next
'Get the Active instance of Outlook
Set oLookApp = GetObject(, "Outlook.Application")
'If error create a new instance of outlook
If Err.Number = 429 Then
'Clear Error
Err.Clear
'Create new instance of Outlook
Set oLookApp = New Outlook.Application
End If
'Create a new email 'Possible Problem here
Set oLookItm = oLookApp.CreateItem(olMailItem)
'Create a reference to the ex range you want to export
For Each Cell In Worksheets("sheet1")
If Not IsEmpty(b20.Value) Then
Set ExcRng = Sheet1.Range("b15:g20")
ElseIf Not IsEmpty(b19.Value) Then
Set ExcRng = Sheet1.Range("b15:g18")
End If
Next
With oLookItm
'Define basic info
.From = "ABC@XYZ.COM"
.To = "123@345.COM"
.CC = ""
.Subject = Range("m3")
.Body = "Please review the attached invoices and confirm that the goods or services have been received and payment should be made."
'Display email
.Display
'Get the active inspector
Set oLookIns = .GetInspector
'Get word editor
Set oWrdDoc = oLookIns.WordEditor
'Specify rang in document
Set oWrdRng = oWrdDoc.Application.ActiveDocument.Content
oWrdRng.Collapse Direction:=wdCollapseEnd
'Add new paragraphand then insert break
Set oWrdRng = oWdEditor.Paragraph.Add
oWrdRng.InsertBreak
'Copy the Range
ExcRng.Copy
'Paste it
oWrdRng.PasteSpecial DataType:=wdPasteMetafilePicture
End With
End Sub
这是给我带来问题的代码部分。
For Each Cell In Worksheets("sheet1")
If Not IsEmpty(b20.Value) Then
Set ExcRng = Sheet1.Range("b15:g20")
ElseIf Not IsEmpty(b19.Value) Then
Set ExcRng = Sheet1.Range("b15:g18")
End If
Next
【问题讨论】:
-
您缺少 Range 参考。试试 IsEmpty(Range(B20).Value) 看看效果是否更好。
-
On Error Resume Next应在设置 Outlook 应用程序对象后使用On Error Goto 0取消。否则,您的代码会愉快地跳过任何错误而不标记它们。 -
我将代码更新为 For Each Cell In Worksheets("sheet1") If Not IsEmpty(Range(b20).Value) Then Set ExcRng = Sheet1.Range("b15:g20") ElseIf Not IsEmpty (Range(b19).Value) Then Set ExcRng = Sheet1.Range("b15:g18") End 如果它粘贴了之前所做的范围,即使在上述建议之后,它也不会基于空进行更改细胞。
-
b20.Value的语法是否有效?试试Range("B20").Value,同样的B19?另外,我几乎肯定你不想检查工作表中的每个单元格?你为什么要循环,你一遍又一遍地检查同一个单元格的值...... -
我不确定语法,VBA 不是我的强项。但它可以按原样设置我想要过去的范围。它会过去的东西。它只是不是动态的。我不想检查每个单元格,我有一个范围要在那里检查,我把它拿出来测试一些东西,忘了把它放回去。
标签: excel vba if-statement