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.Select
citovat