Este fórum está sendo desativado

[luisgera]

Boa noite,
Eu tenho a macro para colar em bitmap um intervalo de células do excel e enviar o email, porém eu gostaria de uma macro para diminuir a altura e a largura do arquivo na hora que eu for enviado por email. Poderiam me ajudar. Por exemplo o arquivo que eu colar no e-mail ira com a altura 11,2 cm e a largura 36,86 cm.

Segue a macro criada, faltando apenas o código para alterar o tamanho da colagem que eu fiz no email.

Sub EnviarEmail()

' Seleciona o intervalo de células a serem enviadas por email.
Sheets("Tabela dinamica - Volume").Select
ActiveSheet.Range("f4:ag31").Select
Application.CutCopyMode = False
Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

Dim OutApp As Object
Dim OutMail As Object

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With OutMail
.To = "email@outlook.com"
.Subject = "Quadro"
'No lugar do Introduction usamos o método Body
.Body = "Bom dia. Segue quadro atualizado. "
.Display
'Pode se usar o Send no lugar do Display, caso queira enviar o email sem abrir a janela, mas só é válido caso o outlook já esteja aberto
End With

'Quando o email é escrito o curso fica no início do texto
'Usamos a tecla END para ir para o final da frase
SendKeys "{END}", True
'Usamos a tecla ENTER para irmos para a linha seguinte
SendKeys "{ENTER}", True
SendKeys "{ENTER}", True
'Por fim usamos CTRL+V, para colar a imagem no corpo do email.
'O CRTL é representado pelo circunflexo (^)
SendKeys "^v", True

End Sub

[babdallas]

Terá que fazer via html. Veja se este 2 tópicos te ajudam:

https://stackoverflow.com/questions/422 ... -vba-excel

https://stackoverflow.com/questions/361 ... ell-values

[osvaldomp]

Experimente:

Código: Selecionar todos

Sub EmailIntervaloDePlanilha()
 Application.ScreenUpdating = False
 Range("G1:AL24").CopyPicture xlScreen, xlPicture
 Sheets.Add
 ActiveSheet.Paste Destination:=Range("A1")
 With Selection
  .ShapeRange.LockAspectRatio = msoTrue
  .ShapeRange.Width = .ShapeRange.Width * 0.45
 End With
 ActiveWorkbook.EnvelopeVisible = True
 With ActiveSheet.MailEnvelope
  .Introduction = "Bom dia. Segue quadro atualizado."
  '.Item.To = "teste@teste.com.br"
  '.Item.CC = "teste@teste.com.br"
  .Item.Subject = "Quadro"
  .Item.send
 End With
 Application.DisplayAlerts = False
 ActiveSheet.Delete
End Sub

.ShapeRange.Width * 0.45 ~~~> este comando reduz o tamanho da imagem para 45% do tamanho original. Altere se quiser.