< návrat zpět

MS Excel


Téma: Odeslání grafu a tabulky emailem rss

Zaslal/a 21.3.2020 14:26

Ahoj všem. Mohli by jste mně prosím někdo poradit?
Potřeboval bych odeslat pomocí makra email tak, abych do něj zkopíroval z listu graf a tabulku. Toto už dělám tak, že převedu mnou požadovaný výběr do pdf a to následně pošlu jako přílohu. To se mně ale nelíbí, protože adresát musí otevřít tuto přílohu. Jde to prosím odeslat tak, aby bylo vše vloženo do emailu, ale ne jako příloha. Předpokládám, že pokud toto jde udělat manuálně(vyjmout - vložit - poslat), tak by to mělo jít i makrem. Bohužel na to nemohu přijít. Můžete mně někdo prosím poslat ukázku makra, které toto umí??? Moc děkuji.

Zaslat odpověď >

#046350
avatar
Ahoj,
využíváme níže uvedené:
Dim Adresa As String

With Workbooks("NAZEV SOUBORU").Worksheets("Pomocny") 'v POMOCNY je uložen seznam přijemců
.Activate
Adresa = .Cells(2, "M")
End With

' Vybrání rozsahu pro vložení dat.
Workbooks("NAZEV SOUBORU").Worksheets("Data pro mail").Activate
ActiveSheet.Range("A1:I100").Select

' Zobrazení "outlooku" v Excelu.
ActiveWorkbook.EnvelopeVisible = True


'Nastavení příjemců, předmětu a odeslání mailu
With ActiveSheet.MailEnvelope
.Item.To = Adresa
.Item.Subject = "PŘEDMĚT MAILU"
.Item.Send

End With

End Sub

Asi by se dalo i lépe napsat, ale i toto funguje :)citovat
#046378
avatar
Ahoj. Díky za radu. Již jsem si to vyřešil a funguje to dobře. Hodně jsem hledal na netu a zkombinoval několik variant.

Sub Odeslani_emailu()
'
' Odeslani_emailu Makro
'
Dim ZalohaListu As Worksheet
Dim PosilanaOblast As Range
Dim ZalohaBunky As Range
Dim StoBunek As Integer
Dim PosledniBunka As Integer


AktualniDatum = Date
PosledniBunka = 1

Sheets("Presentace").Select 'Zvolen? listu Presentace
Range("A1").Select 'Vyber bunky A1
Do While StoBunek < 99 'Dokud nebude aspon 100 bunek po sobe jdoucich prazdnych
PosledniBunka = PosledniBunka + 1
If ActiveCell = "" Then
ActiveCell.Offset(1, 0).Select
StoBunek = StoBunek + 1
Else
ActiveCell.Offset(1, 0).Select
StoBunek = 0
End If
Loop
PosledniBunka = PosledniBunka - 98
Range("A1").Select 'Vyber bunky A1
'On Error GoTo StopMacro

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Vyplnte list / rozsah, kter? chcete poslat
'Pozn?mka: Pokud pou?ijete jednu bunku, ode?le cel? pracovn? list

Set PosilanaOblast = Range(Cells(1, 1), Cells(PosledniBunka, 27)) 'Vyberu oblast kterou chci poslat
Set ZalohaListu = ActiveSheet 'Zazalohuji si aktualne aktivni list

With PosilanaOblast

'Vyberte list s rozsahem, kter? chcete odeslat
.Parent.Select

'Pamatujte na ActiveCell na tomto listu
Set ZalohaBunky = ActiveCell

'Vyberte oblast, kterou chcete poslat
.Select

'Vytvorte po?tu a ode?lete ji
ActiveWorkbook.EnvelopeVisible = True
With .Parent.MailEnvelope

'Nastavte voliteln? doplnovac? pole, kter? se prid?
'text z?hlav? do tela e-mailu.


If l_PosledniDatum = (AktualniDatum - 1) Then
.Introduction = "Ahoj vsem" & vbNewLine & _
" " & vbNewLine & _
"Nize posilam prehled zmetku ze dne " & (AktualniDatum - 1) & vbNewLine & _
" " & vbNewLine & _
"Pokud by jste nekdo nechtel, aby vam tento email chodil, popripade by jste chteli, aby chodil treba jeste nekomu jinemu, tak dejte vedet." & vbNewLine & _
" " & vbNewLine & _
"Mejte se krasne a preji vsem krasny den a co nejmene zmetku :-)"
Else
.Introduction = "Ahoj vsem" & vbNewLine & _
" " & vbNewLine & _
"Nize posilam prehled zmetku z obdobi od " & l_PosledniDatum & " do " & (AktualniDatum - 1) & vbNewLine & _
" " & vbNewLine & _
"Pokud by jste nekdo nechtel, aby vam tento email chodil, popripade by jste chteli, aby chodil treba jeste nekomu jinemu, tak dejte vedet." & vbNewLine & _
" " & vbNewLine & _
"Mejte se krasne a preji vsem krasny den a co nejmene zmetku :-)"
End If

With .Item
'.To = "???"
.To = Adresati
.CC = ""
.BCC = ""
If l_PosledniDatum = (AktualniDatum - 1) Then
.Subject = "Prehled zmetku ze dne " & (AktualniDatum - 1)
Else
.Subject = "Prehled zmetku z obdobi od " & l_PosledniDatum & " do " & (AktualniDatum - 1)
End If
'.Subject = "My subject"
'.Display
.Send
End With

End With

'vyberte puvodn? ActiveCell
'rng.Select
End With

'Aktivujte list, kter? byl aktivn? pred spu?ten?m makra
ZalohaListu.Selectcitovat

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Helios iNuvio

Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.

On-line nástroje