Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Excel » Colocar imagen de rango de celdas de 2 hojas sin quitar la firma predeterminada

Excel - Colocar imagen de rango de celdas de 2 hojas sin quitar la firma predeterminada

Volver
Nuevo Tema
<<>>
 
Vista:
sin imagen de perfil

Colocar imagen de rango de celdas de 2 hojas sin quitar la firma predeterminada

Publicado por angelo (2 intervenciones) el 19/06/2016 19:39:51
Necesito su ayuda necesito colocar 2 rango de celdas como imagen en el cuerpo del correo pero con titulos antes de cada imagen,

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
Sub OutlookEmail()
 
Entrada = InputBox("Ingrese contraseña para continuar", "PROCESO PROTEGIDO")
If Entrada = "2016" Then
 
    Dim OutApp As Object
    Dim OutMail As Object
    Dim Horario As String
    Dim TempFilePath As String
Dim TempFileName As String
Dim FileFullPath As String
Dim MyWb As Workbook
 Dim strbody As String
 
 
Set MyWb = ThisWorkbook
With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With
 Application.Goto Reference:=Worksheets("Resumen").Range("B1")
 Horario = Range("B1").Value
TempFilePath = Environ$("temp") & "\"
TempFileName = "Variacion Horaria Partner - Bitel -" & Format(Now, "mmmm ") & Horario & ".xlsm"
FileFullPath = TempFilePath & TempFileName
MyWb.SaveCopyAs FileFullPath
 
 
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
 
    strbody = "<H3><B></B></H3>" & _
              ".<br>" & _
                            ".<br>" & _
                 "<br><br><B></B>"
 
On Error Resume Next
 
    With OutMail
    .display
        .To = "inplantbitel@bitel.com.pe; renzo.zevallos@bitel.com.pe; AnhNTP@viettel.com.vn; pedro.caceda@bitel.com.pe; luis.marquez@bitel.com.pe; ca.tuesta@gmail.com; inplant@viettelperu.com.pe; analistas.prs@gmail.com"
        .Cc = "supervisionbitel@partner.pe; ramon.tipiana@bitel.com.pe; analistasbitel@partner.pe; mcordova@partner.pe; luis.huamani@bitel.com.pe; mflores@partner.pe; carlos.tuesta@bitel.com.pe"
        .BCC = ""
        .Subject = "Reporte de variación Bitel" & " " & Horario
        .Attachments.Add FileFullPath
        .HTMLBody = strbody & "<br>" & .HTMLBody
        .display
 
 
            Sheets("Reporte").Activate
            Range("b2:q60").CopyPicture Appearance:=xlScreen, Format:=xlPicture
      Application.Wait Now + TimeValue("00:00:01")
    SendKeys "^v"
           Application.Wait Now + TimeValue("00:00:01")
              Sheets("ReporteDiario").Activate
            Range("b2:m34").CopyPicture Appearance:=xlScreen, Format:=xlPicture
      Application.Wait Now + TimeValue("00:00:01")
    SendKeys "^v"
 End With
 
 On Error GoTo 0
 Kill FileFullPath
    Set OutMail = Nothing
    Set OutApp = Nothing
 
    Else
MsgBox "Acceso Denegado", vbExclamation, "CLAVE INCORRECTA"
End If
Sheets("Reporte").Activate
End Sub
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder