VBA - opakování procedury
Napsal: 04 kvě 2021 15:34
Dobrý den,
řekněme, že umím trochu základy VBA a dokáži napsat nějaký kód. V excelu mám kód pro odesílaní emailové zprávy. Vše funguje pro jeden řádek. Potřeboval bych poradit, jak to udělat, abych pro ostatní řádky nemusel celý kód prostě zkopírovat a jen změnit Range.
kód zde :
Sub ExcelFollowHyperlink()
Dim rngOblast As Range
Dim rngBunka As Range
Dim strAdresat As String
Dim strPredmet As String
Dim strObsah As String
Dim strRet As String
Dim SPZ As String
Dim Text As String
'náhrada vbLf
Const cstrLf As String = "%0A"
'adresát
strAdresat = Range("D2")
'předmět
HPO = Range("A2")
strPredmet = "Text"
DATUMVYKLADKY = Range("C2")
SPZ = Range("B2")
Text1CZ = Range("G2")
Text2CZ = Range("G3")
Text1EN = Range("G4")
Text2EN = Range("G5")
PodpisCZ = Range("G6")
PodpisEN = Range("G7")
Jmeno = Range("G8")
Pozice = Range("G9")
Tel = Range("G10")
Email = Range("G11")
HPO = Range("A2")
Text = Text1CZ & SPZ & " " & " a doručena dne " & DATUMVYKLADKY & " & & cstrLf & cstrLf & PodpisCZ
Worksheets("List2").Range("F1") = Text
Set rngOblast = Worksheets("List2").Range("F1")
'hlavička obsahu
strObsah = "Dobrý den" & cstrLf
'načtení adres a obsahů jednotlivých buněk oblasti
For Each rngBunka In rngOblast
strObsah = strObsah & cstrLf & rngOblast
Next rngBunka
'sestavení řetězce pro metodu FollowHyperlink
strRet = "mailto:" & strAdresat & "?"
'předmět
strRet = strRet & "subject=" & strPredmet & "&"
'obsah
strRet = strRet & "body=" & strObsah
'odeslání e-mailu
ActiveWorkbook.FollowHyperlink (strRet)
'simulované potvrzení dialogu (Odeslat, ALT+A)
'Microsoft Outlook 2010 CZ
Application.Wait (Now + TimeValue("0:00:02"))
SendKeys "%a", True
End SUB
Nebo například u funkce VzrDATUM4 = WorksheetFunction.VLookup(Najdi, Worksheets("01 Leden").Range("B4:AJ1000"), 11, False)
Mám v excelu záložky Leden - Prosinec. Pomocí vzorců jde přes IFERROR, ale jak to udělat ve VBA?
Moc děkuji za pomoc
řekněme, že umím trochu základy VBA a dokáži napsat nějaký kód. V excelu mám kód pro odesílaní emailové zprávy. Vše funguje pro jeden řádek. Potřeboval bych poradit, jak to udělat, abych pro ostatní řádky nemusel celý kód prostě zkopírovat a jen změnit Range.
kód zde :
Sub ExcelFollowHyperlink()
Dim rngOblast As Range
Dim rngBunka As Range
Dim strAdresat As String
Dim strPredmet As String
Dim strObsah As String
Dim strRet As String
Dim SPZ As String
Dim Text As String
'náhrada vbLf
Const cstrLf As String = "%0A"
'adresát
strAdresat = Range("D2")
'předmět
HPO = Range("A2")
strPredmet = "Text"
DATUMVYKLADKY = Range("C2")
SPZ = Range("B2")
Text1CZ = Range("G2")
Text2CZ = Range("G3")
Text1EN = Range("G4")
Text2EN = Range("G5")
PodpisCZ = Range("G6")
PodpisEN = Range("G7")
Jmeno = Range("G8")
Pozice = Range("G9")
Tel = Range("G10")
Email = Range("G11")
HPO = Range("A2")
Text = Text1CZ & SPZ & " " & " a doručena dne " & DATUMVYKLADKY & " & & cstrLf & cstrLf & PodpisCZ
Worksheets("List2").Range("F1") = Text
Set rngOblast = Worksheets("List2").Range("F1")
'hlavička obsahu
strObsah = "Dobrý den" & cstrLf
'načtení adres a obsahů jednotlivých buněk oblasti
For Each rngBunka In rngOblast
strObsah = strObsah & cstrLf & rngOblast
Next rngBunka
'sestavení řetězce pro metodu FollowHyperlink
strRet = "mailto:" & strAdresat & "?"
'předmět
strRet = strRet & "subject=" & strPredmet & "&"
'obsah
strRet = strRet & "body=" & strObsah
'odeslání e-mailu
ActiveWorkbook.FollowHyperlink (strRet)
'simulované potvrzení dialogu (Odeslat, ALT+A)
'Microsoft Outlook 2010 CZ
Application.Wait (Now + TimeValue("0:00:02"))
SendKeys "%a", True
End SUB
Nebo například u funkce VzrDATUM4 = WorksheetFunction.VLookup(Najdi, Worksheets("01 Leden").Range("B4:AJ1000"), 11, False)
Mám v excelu záložky Leden - Prosinec. Pomocí vzorců jde přes IFERROR, ale jak to udělat ve VBA?
Moc děkuji za pomoc