Excel 将范围添加为图像
我想在代码中添加一个范围作为图像。范围应该是从A1到d30,我想在这行后面加上:Excel 将范围添加为图像,excel,vba,Excel,Vba,我想在代码中添加一个范围作为图像。范围应该是从A1到d30,我想在这行后面加上: Msg = Msg & FechaVencimiento & " Todas las cantidades se encuentran correctamente ingresadas en el sistema." & vbNewLine & vbNewLine & vbNewLine & vbNewLine 这是我的代码: Sub Envia
Msg = Msg & FechaVencimiento & " Todas las cantidades se encuentran correctamente ingresadas en el sistema." & vbNewLine & vbNewLine & vbNewLine & vbNewLine
这是我的代码:
Sub EnviarEmail()
Dim OutlookApp As Outlook.Application
Dim MItem As Outlook.MailItem
Dim cell As Range
Dim Asunto As String
Dim Correo As String
Dim Destinatario As String
Dim Saldo, A As String
Dim Msg As String
If Range("f3") = 1 Then
salso = "Buena tarde,"
End If
If Range("f3") = 2 Then
salso = "Buena noche,"
End If
If Range("f3") = 3 Then
salso = "Buen día,"
End If
Set OutlookApp = New Outlook.Application
'
For Each cell In Range("w1")
'
Asunto = "Constancia de entregas"
Correo = cell.Value
Saldo = salso
FechaVencimiento = Now
A = Range("d4")
Msg = Saldo & vbNewLine & vbNewLine & vbNewLine & vbNewLine
Msg = Msg & "Adjunto constancia de entregas del dia "
Msg = Msg & FechaVencimiento & " Todas las cantidades se encuentran correctamente ingresadas en el sistema." & vbNewLine & vbNewLine & vbNewLine & vbNewLine
Msg = Msg & "Saludos," & vbNewLine & vbNewLine & vbNewLine & vbNewLine
Msg = Msg & A & vbNewLine
Msg = Msg & "Control de Calidad y Entregas" & vbNewLine & "Ext 210" & vbNewLine
Msg = Msg & "Goodyear Rubber & Tire Co" & vbNewLine
Msg = Msg & "www.goodyear.com" & vbNewLine
'
Set MItem = OutlookApp.CreateItem(olMailItem)
With MItem
.To = xxxx
.CC = xxxx
.Subject = Asunto
.Body = Msg
.Attachments.Add ActiveWorkbook.FullName
.Send
'
End With
'
Next
'
End Sub
您可以使用
CopyPicture
方法将范围复制为图像
您可以使用WordEditor
将消息编辑为富文本
' ...
For Each cell In Range("w1")
'
Asunto = "Constancia de entregas"
Correo = cell.Value
Saldo = salso
FechaVencimiento = Now
A = Range("d4")
'
Set MItem = OutlookApp.CreateItem(olMailItem)
With MItem
.To = "ktgk.chr66g@gmail.com"
.CC = "ktgk.chr66g@gmail.com"
.Subject = Asunto
.Attachments.Add ActiveWorkbook.FullName
.Display False
With .GetInspector.WordEditor.Windows(1).Selection
.Font.Name = "Calibri"
.Font.Size = "11"
Msg = ""
Msg = Saldo & vbNewLine & vbNewLine & vbNewLine & vbNewLine
Msg = Msg & "Adjunto constancia de entregas del dia "
Msg = Msg & FechaVencimiento & " Todas las cantidades se encuentran correctamente ingresadas en el sistema." & vbNewLine & vbNewLine & vbNewLine & vbNewLine
.TypeText Msg
.TypeText Chr(13)
' Copy & paste a range as an image
Range("A1:D30").CopyPicture
.Paste
.TypeText Chr(13)
Msg = ""
Msg = Msg & "Saludos," & vbNewLine & vbNewLine & vbNewLine & vbNewLine
Msg = Msg & A & vbNewLine
Msg = Msg & "Control de Calidad y Entregas" & vbNewLine & "Ext 210" & vbNewLine
Msg = Msg & "Goodyear Rubber & Tire Co" & vbNewLine
Msg = Msg & "www.goodyear.com" & vbNewLine
.TypeText Msg
End With
.Send
'
End With
'
Next
'
' Make sure messages are sent
OutlookApp.GetNamespace("MAPI").SendAndReceive True