Поместить текст над вставленным диапазоном

у меня есть код ниже, который вставляет диапазон в тело электронной почты, но моя проблема заключается в теле текста. Это тело: находится ниже вставленного диапазона при запуске кода, может быть, кто-то может помочь, как поместить его выше вставленного диапазона

Sub SendEmailWithRange()
    Dim MyRange As Range
    Dim doc As Object
    
    Set MyRange = Sheets("Sheet1").Range("A4").CurrentRegion
    
    With CreateObject("outlook.application").CreateItem(0)
        .Display 'Change to .Send to send the email immediately
        .Body = "This is the body:" '& vbNewLine & vbNewLine
            Set doc = .GetInspector.WordEditor
            MyRange.Copy
            doc.Range(x, x).Paste
        .To = Range("I3").Value
        .Subject = "My subject"
        Application.CutCopyMode = 0
    End With
    
End Sub
Преобразование HTML-таблицы в профессиональный документ Excel
Преобразование HTML-таблицы в профессиональный документ Excel
Это самый простой способ создания Excel из HTML-таблицы.
Импорт excel в laravel в базу данных
Импорт excel в laravel в базу данных
Здравствуйте, дорогой читатель, в этой статье я расскажу практическим и быстрым способом, как импортировать файл Excel в вашу базу данных с помощью...
1
0
50
1
Перейти к ответу Данный вопрос помечен как решенный

Ответы 1

Ответ принят как подходящий

Возможно, вам придется установить x перед вставкой. x = doc.Range.End - 1 находит конец документа меньше 1

    Sub SendEmailWithRange()
    Dim MyRange As Range
    Dim doc As Object
    
    Set MyRange = Sheets("Sheet1").Range("A4").CurrentRegion
    
    With CreateObject("outlook.application").CreateItem(0)
        .Display                                 'Change to .Send to send the email immediately
        
        .Body = "This is the body:"              '& vbNewLine & vbNewLine
        Set doc = .GetInspector.WordEditor
        
        x = doc.Range.End - 1
        MyRange.Copy
        doc.Range(x).Paste
            
        .To = Range("I3").Value
        .Subject = "My subject"
        
        Application.CutCopyMode = 0
    End With
    
End Sub

Добавьте больше линий внизу тела

    Sub SendEmailWithRange()
    Dim MyRange As Range
    Dim doc As Object
    
    Set MyRange = Sheets("Sheet1").Range("A4").CurrentRegion
    
    With CreateObject("outlook.application").CreateItem(0)
        .Display                                 'Change to .Send to send the email immediately
        
        .Body = "This is the body:"              '& vbNewLine & vbNewLine
        Set doc = .GetInspector.WordEditor
        
        x = doc.Range.End - 1
        MyRange.Copy
        doc.Range(x).Paste
            
        x = doc.Range.End - 1
        doc.Range(x) = "More Stuff"              'add more stuff
        
        x = doc.Range.End - 1
        doc.Range(x) = vbNewLine & "Even More Stuff" 'add more stuff with New line
        
        x = doc.Range.End - 1
        doc.Range(x) = vbNewLine & vbNewLine & vbNewLine & _
                       "Even More Stuff"         'add more stuff with multi-line breaks
        
        .To = Range("I3").Value
        .Subject = "My subject"
        
        Application.CutCopyMode = 0
    End With
    
End Sub

Спасибо, это работает. Если я хочу поместить «С уважением, Джон Доу» внизу тела, которое находится ниже вставленного диапазона, как мне это сделать?

k1dr0ck 20.02.2023 03:20

Просто продолжайте добавлять строки, я добавил еще один код, показывающий это.

Davesexcel 20.02.2023 12:35

Другие вопросы по теме