Note: The other languages of the website are Google-translated. Back to English

Jak odeslat e-mail, pokud je určitá buňka upravena v aplikaci Excel?

Tento článek pojednává o odeslání e-mailu přes Outlook, když je v Excelu upravena buňka v určitém rozsahu.

Pošlete e-mail, pokud je buňka v určitém rozsahu upravena kódem VBA


Pošlete e-mail, pokud je buňka v určitém rozsahu upravena kódem VBA

Pokud potřebujete automaticky vytvořit nový e-mail s připojeným aktivním sešitem, když je v určitém listu upravena buňka v rozsahu A2:E11, může vám pomoci následující kód VBA.

1. V listu, který potřebujete odeslat e-mail na základě jeho upravené buňky v určitém rozsahu, klikněte pravým tlačítkem na kartu listu a poté klikněte na Zobrazit kód z kontextové nabídky. Viz snímek obrazovky:

2. Ve vyskakovacím okně Microsoft Visual Basic pro aplikace zkopírujte a vložte pod kód VBA do okna Kód.

Kód VBA: Odeslat e-mail, pokud je buňka ve specifikovaném rozsahu upravena v aplikaci Excel

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 2017/9/12
    Dim xRgSel As Range
    Dim xOutApp As Object
    Dim xMailItem As Object
    Dim xMailBody As String
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set xRg = Range("A2:E11")
    Set xRgSel = Intersect(Target, xRg)
    ActiveWorkbook.Save
    If Not xRgSel Is Nothing Then
        Set xOutApp = CreateObject("Outlook.Application")
        Set xMailItem = xOutApp.CreateItem(0)
        xMailBody = "Cell(s) " & xRgSel.Address(False, False) & _
            " in the worksheet '" & Me.Name & "' were modified on " & _
            Format$(Now, "mm/dd/yyyy") & " at " & Format$(Now, "hh:mm:ss") & _
            " by " & Environ$("username") & "."

        With xMailItem
            .To = "Email Address"
            .Subject = "Worksheet modified in " & ThisWorkbook.FullName
            .Body = xMailBody
            .Attachments.Add (ThisWorkbook.FullName)
            .Display
        End With
        Set xRgSel = Nothing
        Set xOutApp = Nothing
        Set xMailItem = Nothing
    End If
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Poznámky:

1). V kódu A2: E11 je rozsah, na kterém budete posílat e-maily.
2). Změňte prosím text e-mailu, jak potřebujete xMailBody řádek v kódu.
3). Nahradit Emailová adresa s e-mailovou adresou příjemce v řádku .To = "E-mailová adresa".
4). Změňte předmět e-mailu v řádku .Subject = "List upraven v" & ThisWorkbook.FullName.

3. zmáčkni Další + Q současně zavřete Microsoft Visual Basic pro aplikace okno.

Od této chvíle se upraví libovolná buňka v rozsahu A2: E11, vytvoří se nový e-mail s připojeným aktualizovaným sešitem. A všechna zadaná pole, jako je předmět, příjemce a tělo e-mailu, budou uvedena v e-mailu. Zašlete prosím e-mail.

Poznámka: Kód VBA funguje pouze v případě, že jako e-mailový program používáte Outlook.


Související články:


Nejlepší kancelářské nástroje produktivity

Kutools pro Excel řeší většinu vašich problémů a zvyšuje vaši produktivitu o 80%

  • Opakované použití: Rychle vložte složité vzorce, grafy a cokoli, co jste dříve používali; Šifrovat buňky s heslem; Vytvořte seznam adresátů a posílat e-maily ...
  • Super Formula Bar (snadno upravit více řádků textu a vzorce); Rozložení pro čtení (snadno číst a upravovat velké množství buněk); Vložit do filtrovaného rozsahu...
  • Sloučit buňky / řádky / sloupce bez ztráty dat; Rozdělit obsah buněk; Zkombinujte duplicitní řádky / sloupce... Zabraňte duplicitním buňkám; Porovnat rozsahy...
  • Vyberte možnost Duplikovat nebo Jedinečný Řádky; Vyberte prázdné řádky (všechny buňky jsou prázdné); Super hledání a fuzzy hledání v mnoha sešitech; Náhodný výběr ...
  • Přesná kopie Více buněk beze změny odkazu na vzorec; Automaticky vytvářet reference do více listů; Vložte odrážky, Zaškrtávací políčka a další ...
  • Extrahujte text, Přidat text, Odebrat podle pozice, Odebrat mezeru; Vytváření a tisk mezisoučtů stránkování; Převod mezi obsahem buněk a komentáři...
  • Super filtr (uložit a použít schémata filtrů na jiné listy); Rozšířené řazení podle měsíce / týdne / dne, frekvence a dalších; Speciální filtr tučnou kurzívou ...
  • Kombinujte sešity a pracovní listy; Sloučit tabulky na základě klíčových sloupců; Rozdělte data do více listů; Dávkový převod xls, xlsx a PDF...
  • Více než 300 výkonných funkcí. Podporuje Office / Excel 2007-2021 a 365. Podporuje všechny jazyky. Snadné nasazení ve vašem podniku nebo organizaci. Plné funkce 30denní bezplatná zkušební verze. 60denní záruka vrácení peněz.
karta kte 201905

Office Tab přináší do Office rozhraní s kartami a usnadňuje vám práci

  • Povolte úpravy a čtení na kartách ve Wordu, Excelu, PowerPointu, Publisher, Access, Visio a Project.
  • Otevřete a vytvořte více dokumentů na nových kartách ve stejném okně, nikoli v nových oknech.
  • Zvyšuje vaši produktivitu o 50%a snižuje stovky kliknutí myší každý den!
officetab dno
Komentáře (37)
Zatím žádné hodnocení. Buďte první, kdo ohodnotí!
Tento komentář byl moderátorem webu minimalizován
Jsem zaseknutý pod kódem VB. Snažím se dostat e-mailové upozornění pro uživatele, kde byla data změněna. E-mail funguje, ale když provedu jakoukoli změnu, e-mail se spustí okamžitě, ale chci e-mail, když je list aplikace Excel uložen a uzavřen po provedení všech změn všem uživatelům, kteří to ovlivnili. Také by to mělo fungovat pro kterýkoli z listů v celém excelovém sešitu.

Prosím, pomozte ...

Private Sub Workbook_BeforeSave (ByVal SaveAsUI jako Boolean, Zrušit jako Boolean)

'****Deklarace objektů a proměnných******

Dim xRgSel jako rozsah Dim xOutApp jako objekt Dim xMailItem jako objekt Dim xMailBody jako řetězec Dim mailTo jako řetězec

On Error Resume Next

Sheets("TargetSheet").Range("TargetRange").Vyberte

Application.ScreenUpdating = False Application.DisplayAlerts = False

'Nastavit xRg = Range("A" & Rows.Count).End(xlUp).Row

Nastavit xRg = Range("A2:DA1000")
Nastavit xRgSel = Intersect(Target, xRg)


ActiveWorkbook.Save
'********** Otevření aplikace Outlook************

If Not xRgSel Is Nothing Then

Set xOutApp = CreateObject("Outlook.Application")
Nastavit xMailItem = xOutApp.CreateItem(0)

xMailBody = "Cell(s) " & xRgSel.Address(False, False) & _
" v pracovním listu '" & Já.Jméno & "' byly upraveny dne " & _
Format$(Nyní, "mm/dd/rrrr") & " na " & Format$(Nyní, "hh:mm:ss") & _
" od " & Environ$("uživatelské jméno") & "."
'************ Seznam příjemců ************

If Cells(xRgSel.Row, "A").Value = "Pankaj" Then

mailTo = "pank12***@gmail.com"

End If

If Cells(xRgSel.Row, "A").Value = "Nitin" Then

mailTo = "pank****@gmail.com"

End If

If Cells(xRgSel.Row, "A").Value = "Chandan" Then

mailTo = "pakxro**@gmail.com"

End If
'************ Psaní e-mailu*************

S xMailItem

.To = mailTo
.Subject = "List upraven v" & ThisWorkbook.FullName
.Tělo = xMailBody
'.Attachments.Add (ThisWorkbook.FullName)
.Zobrazit

Konec s

Nastavte xRgSel = Nic
Nastavte xOutApp = Nic
Nastavit xMailItem = nic

End If

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Tento komentář byl moderátorem webu minimalizován
Vážený Pankaj Shukla,
Zveřejněte svůj dotaz ohledně Excelu na našem fóru: https://www.extendoffice.com/forum.html získat další podporu o Excelu od našeho odborníka na Excel.
Tento komentář byl moderátorem webu minimalizován
Podařilo se mi vytvořit makro, ale mám problém. Chtěl bych automaticky odeslat e-mail, když buňka dosáhne určité prahové hodnoty. Buňka je vzorec. Když součet výpočtu klesne pod uvedenou prahovou hodnotu, nedělá nic; pokud však napíšu přímo do buňky, zpracuje makro podle plánu. Nekazí vzorec makro?
Tento komentář byl moderátorem webu minimalizován
Ahoj Sissy Jonesová,
Metoda v tomto článku: Jak automaticky odesílat e-maily na základě hodnoty buňky v Excelu?
https://www.extendoffice.com/documents/excel/4656-excel-send-email-based-on-cell-value.html vám může pomoci vyřešit problém.
Tento komentář byl moderátorem webu minimalizován
Vážení Admin


Potřebuji tvou pomoc,



Mám Excel na sledování podrobností o každodenní práci našeho pracovníka z terénu, takže je možné spustit e-mail z excelového listu, pokud ten chlap nedokázal aktualizovat data v tomto excelovém listu v daný čas.
Tento komentář byl moderátorem webu minimalizován
Dobrý den,
S tím nelze pomoci.
Tento komentář byl moderátorem webu minimalizován
Pokud chci místo adresy poslat hodnotu buňky... tak co mám v kódu změnit?
Tento komentář byl moderátorem webu minimalizován
Dobrý den,
Můžete vyzkoušet níže uvedený kód VBA.

Soukromá dílčí tabulka_Změna (ByVal Target As Range)
Dim xRgSel jako rozsah
Dim xOutApp jako objekt
Dim xMailItem jako objekt
Dim xMailBody jako řetězec
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Nastavit xRg = Range("A2:E11")
Nastavit xRgSel = Intersect(Target, xRg)
ActiveWorkbook.Save
If Not xRgSel Is Nothing Then
Set xOutApp = CreateObject("Outlook.Application")
Nastavit xMailItem = xOutApp.CreateItem(0)
xMailBody = "Cell(s) " & xRgSel.Address(False, False) & _
xRgSel.Value & _
" v pracovním listu '" & Já.Jméno & "' byly upraveny dne " & _
Format$(Nyní, "mm/dd/rrrr") & " na " & Format$(Nyní, "hh:mm:ss") & _
" od " & Environ$("uživatelské jméno") & "."

S xMailItem
.To = "E-mailová adresa"
.Subject = "List upraven v" & ThisWorkbook.FullName
.Tělo = xMailBody
.Attachments.Add (ThisWorkbook.FullName)
.Zobrazit
Konec s
Nastavte xRgSel = Nic
Nastavte xOutApp = Nic
Nastavit xMailItem = nic
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Tento komentář byl moderátorem webu minimalizován
Co když chceme pouze aktualizované komentáře v této buňce a ne celou hodnotu buňky Mělo by se zobrazovat pouze nejnovější komentáře přidané do buňky
Tento komentář byl moderátorem webu minimalizován
Zjistili jste to?
Tento komentář byl moderátorem webu minimalizován
Skvělé informace.
Otázka týkající se informací, které lze přidat do e-mailu.
Použijte svůj příklad výše....

Pokud byste měli hodnotu v F4, jak byste zahrnuli hodnotu F4 do e-mailu, který byl vygenerován při úpravě D4?
Tento komentář byl moderátorem webu minimalizován
jestli musím poslat celý ten řádek?
Tento komentář byl moderátorem webu minimalizován
Zkoušel jsem výše uvedený kód VBA: Odeslat e-mail, pokud je buňka v zadaném rozsahu upravena v aplikaci Excel. Tento VBA mi funguje kromě odesílání e-mailů. Při úpravě dat v daném rozsahu se automaticky vygeneruje email s upravenými detaily buňky. E-mail se však automaticky neodešle příjemci a uživatel musí v e-mailu kliknout na tlačítko Odeslat. Tady se dívám, že e-mail se musí automaticky odeslat příjemcům, když je vygenerován. Pomozte mi prosím poskytnout kód pro toto. Mnohokrát děkuji
Tento komentář byl moderátorem webu minimalizován
Ahoj Jimmy Joseph,
Nahraďte prosím řádek ".Display" za ".Send". Doufám, že pomůžu. Děkuji za komentář.
Tento komentář byl moderátorem webu minimalizován
Ahoj; existuje způsob, jak změnit text zobrazený pomocí informací z jiných buněk (z prvního řádku a prvního sloupce)? pokud například změním buňku K15, chci do zprávy zahrnout informace o buňkách A15 a K1? co bych měl změnit v kódu? Děkuji mnohokrát
Tento komentář byl moderátorem webu minimalizován
ahoj Laono. zjistíte, jak to můžete udělat?
Tento komentář byl moderátorem webu minimalizován
Ahoj. Jak upravím kód tak, aby byl e-mail odeslán na jinou e-mailovou adresu, pokud je upraven jiný rozsah buněk?
Tento komentář byl moderátorem webu minimalizován
Nějaká pomoc s touto žádostí? Mám stejný problém. Chci přidat více e-mailových adres na řádek, ale když změním jeden řádek, změní se celý list. Jak mohu omezit změny pouze na jeden řádek?
Tento komentář byl moderátorem webu minimalizován
Upravit řádek:
1). V kódu je A2:E11 rozsah, na základě kterého budete odesílat e-maily.
a
3). Nahraďte e-mailovou adresu e-mailovou adresou příjemce v řádku .To = "E-mailová adresa".

Funguje dobře.
Tento komentář byl moderátorem webu minimalizován
Můžete to prosím dále vysvětlit. Jak zopakujete kód pro odeslání na jiný e-mail na základě jiného upravovaného rozsahu. Zkoušel jsem zkopírovat a vložit kód níže a změnit jej podle vašeho komentáře, ale stále se zdá, že pouze první rozsah provádí příkaz a píše e-mail.
Tento komentář byl moderátorem webu minimalizován
Má na to někdo odpověď?
Tento komentář byl moderátorem webu minimalizován
Dobrý den, pokoušel jsem se odesílat e-maily na můj list s jednou hodnotou změněnou na listu. Pokud se ve sloupci H stav změní na ="4", ID objednávky vlevo by mělo být zasláno jednomu uživateli. List funguje dynamicky, takže mám rozsah od D9:D140, kde jsou uložena ID objednávky a změny stavu se provádějí ve stejném rozsahu na H9:H140. Jak mohu dosáhnout cíle a odeslat svému zákazníkovi ID objednávky, když byl stav změněn na ="4"?
Tento komentář byl moderátorem webu minimalizován
Bylo by možné zobrazit jinou referenční buňku v xMailBody ve stejném sloupci místo upravené adresy buňky?
Tento komentář byl moderátorem webu minimalizován
Ahoj Same, myslíš náhodně vybrat referenční buňku ve stejném sloupci adresy upravené buňky? Nebo ručně zadat referenční buňku do řádku xMailBody kódu? Je snadné ručně zadat referenční buňku do kódu, stačí uzavřít referenční buňku do dvojitých uvozovek, jak je uvedeno níže: xMailBody = "Cell(s) " & "D3" & "," & "D8" & _

Tento komentář byl moderátorem webu minimalizován
Je možné to změnit, aby se e-mail zobrazil pouze v případě, že byla buňka v rozsahu změněna na „Ano“. Chtěl bych, aby to nedělalo nic, pokud je to nějaká jiná hodnota.
Tento komentář byl moderátorem webu minimalizován
Děkuji za kód, tento kód funguje, když zadám hodnotu a stisknu enter. Ale v mém případě se buňka automaticky plní vzorcem a po dosažení hodnoty neotevře e-mail, takže kód v tomto případě nefunguje. Děkuji předem!
Tento komentář byl moderátorem webu minimalizován
ahoj hakana,
Následující kód VBA vám může pomoci vyřešit problém. Zkuste to prosím. Děkujeme vám za vaši reakci.

Private Sub Worksheet_Change (ByVal Target As Range)
'Aktualizováno Extendoffice 2022 / 04 / 15
Dim xRgSel jako rozsah
Dim xOutApp jako objekt
Dim xMailItem jako objekt
Dim xMailBody jako řetězec
Dim xBoolean Jako Boolean
Dim xItsRG jako rozsah
Dim xDDs jako rozsah
Dim xDs As Range
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
xBoolean = False
Nastavit xRg = Range("E2:E13")

Nastavit xItsRG = Intersect(Target, xRg)
Nastavit xDDs = Intersect(Target.DirectDependents, xRg)
Nastavit xDs = Intersect(Target.Dependents, xRg)
If Not (xItsRG Is Nothing) Then
Nastavte xRgSel = xItsRG
xBoolean = Pravda
ElseIf Not (xDDs Is Nothing) Then
Nastavte xRgSel = xDDs
xBoolean = Pravda
ElseIf Not (xDs Is Nothing) Then
Nastavte xRgSel = xDs
xBoolean = Pravda
End If


ActiveWorkbook.Save
If xBoolean Then
Debug.Print xRgSel.Address


Set xOutApp = CreateObject("Outlook.Application")
Nastavit xMailItem = xOutApp.CreateItem(0)
xMailBody = "Cell(s) " & xRgSel.Address(False, False) & _
" v pracovním listu '" & Já.Jméno & "' byly upraveny dne " & _
Format$(Nyní, "mm/dd/rrrr") & " na " & Format$(Nyní, "hh:mm:ss") & _
" od " & Environ$("uživatelské jméno") & "."

S xMailItem
.To = "E-mailová adresa"
.Subject = "List upraven v" & ThisWorkbook.FullName
.Tělo = xMailBody
.Attachments.Add (ThisWorkbook.FullName)
.Zobrazit
Konec s
Nastavte xRgSel = Nic
Nastavte xOutApp = Nic
Nastavit xMailItem = nic
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Tento komentář byl moderátorem webu minimalizován
Dobrý den, vytvořil jsem podobný kód, ale chtěl bych *** podmínku, že pokud je smazána hodnota buňky, neodešle e-mail při uložení/zavření. Odešle e-mail pouze po zadání hodnoty buňky. Víte, jak na to? Toto je můj kód:

KÓD PRO AUTOMATICKÝ E-MAIL NĚKOMU PŘI AKTUALIZACI SEŠITU EXCEL

KÓD LISTU:

Možnost Explicit 'Rozsah události změny listu aplikace Excel
Soukromá dílčí tabulka_Změna (ByVal Target As Range)
If Not Intersect(Target, Range("C3:D62")) Is Nothing Then
'Target.EntireRow.Interior.ColorIndex = 15
Rozsah("XFD1048576"). Hodnota = 15
End If
If Not Intersect(Target, Range("I3:J21")) Is Nothing Then
'Target.EntireRow.Interior.ColorIndex = 15
Rozsah("XFD1048576"). Hodnota = 15
End If
End Sub


KÓD SEŠITU:

Private Sub Workbook_BeforeClose (Zrušit jako Boolean)
If Me.Saved = False Then Me.Save

Dim xOutApp jako objekt
Dim xMailItem jako objekt
Dim xName As String

If Range("XFD1048576").Hodnota = 15 Pak
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Nastavit xMailItem = xOutApp.CreateItem(0)
xName = ActiveWorkbook.FullName
S xMailItem
.To = "e-mail"
.CC = ""
.Předmět = "zpráva"
.Tělo = "zpráva!"
.Přílohy.*** xJméno
.Zobrazit
'.poslat
Konec s
End If
Nastavit xMailItem = nic
Nastavte xOutApp = Nic



End Sub

Soukromá podřízená sešit_Open ()
Rozsah("XFD1048576").Vymazat
End Sub
Tento komentář byl moderátorem webu minimalizován
Ahoj všem,

der Code würde gut für mein Vorhaben passen, aber gibt es die Möglichkeit, dass er eine E-Mail beim speichern schreibt mit allen Zellen die geändert wurden? So wie es jetzt ist ,würde er jede geänderte Zelle einzeln senden. Dies ist dann problematisch wenn zB 10 Zellen angepasst werden bylo 10 E-Mails bedeuten würde. A gibt es die Möglichkeit, die gesamte geänderte Zelle bei mir von A bis Y in einer E-Mail zu senden? Bisher haut der ja die Zellnummer in die E-Mail, wenn aber jemand anders Filtert wird er die Änderung nicht mehr finden.
Tento komentář byl moderátorem webu minimalizován
Ahoj Esser123,
Pomoci mohou následující kódy VBA. Po úpravě buněk v zadaném rozsahu a uložení sešitu se zobrazí e-mail se seznamem všech upravených buněk v těle e-mailu a sešit se také vloží jako příloha do e-mailu. Postupujte podle následujících kroků:
1. Otevřete list obsahující buňky, na základě kterých chcete odesílat e-maily, klepněte pravým tlačítkem na záložku listu a klepněte Zobrazit kód z nabídky po kliknutí pravým tlačítkem. Poté zkopírujte následující kód do okna listu (kódu).
Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20220921
Dim xAddress As String
Dim xDRg, xRgSel, xRg As Range

xAddress = "A1:A8"
Set xDRg = Range(xAddress)
Set xRgSel = Intersect(Target, xDRg)
On Error GoTo Err1
If Not xRgSel Is Nothing Then
If ThisWorkbook.gChangeRange = "" Then
ThisWorkbook.gChangeRange = xRgSel.AddressLocal(False, False, xlA1, True, False)
Else
Set xRg = Range(ThisWorkbook.gChangeRange)
Set xRg = Application.Union(xRg, xRgSel)
ThisWorkbook.gChangeRange = xRg.AddressLocal(False, False, xlA1, True, False)
End If
End If
Exit Sub
Err1:
      ThisWorkbook.gChangeRange = xRgSel.AddressLocal(False, False, xlA1, True, False)
End Sub

2. V editoru Visual Basic dvakrát klikněte Tato pracovní kniha v levém podokně a zkopírujte následující kód VBA do ThisWorkbook (Code) okno.
Option Explicit
Public gChangeRange As String
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
'Updated by Extendoffice 20220921
Dim xRgSel, xRg As Range
Dim xOutApp As Object
Dim xMailItem As Object
Dim xMailBody As String
'On Error Resume Next
On Error GoTo Err1
Set xRg = Range(gChangeRange)
If Not xRg Is Nothing Then
   Set xOutApp = CreateObject("Outlook.Application")
        Set xMailItem = xOutApp.CreateItem(0)
        xMailBody = "Email Body: " & vbCrLf & "The following cells were modified:" & xRg.Address(False, False)
        With xMailItem
            .To = "Email Address"
            .Subject = "Worksheet modified in " & ThisWorkbook.FullName
            .Body = xMailBody
            .Attachments.Add (ThisWorkbook.FullName)
            .Display
        End With
        Set xRgSel = Nothing
        Set xOutApp = Nothing
        Set xMailItem = Nothing
End If
Err1:
gChangeRange = ""
End Sub
Tento komentář byl moderátorem webu minimalizován
Potřebuji pomoc se spuštěním e-mailu s malou změnou. Místo číselné hodnoty nebo ručního zadávání informací do buňky se buňky ve sloupci B změní na 'Y' vyvolané vzorcem v jiných buňkách v daném řádku. Vzorec pro sloupec B je =IF([@[Quantity in Stock]]>[@[Reorder Level]],,"Y"), což ukazuje, že zásoby jsou málo skladem a je třeba je znovu objednat. Potřebuji spustit automatický e-mail, když se hodnota buňky ve sloupci B změní na 'Y', takže jsem automaticky informován e-mailem o nízkých zásobách. Vyzkoušel jsem vše, co mě napadlo v již poskytnutých kódech, ale zdá se, že nic pro mě nefunguje... prosím pomozte!
Tento komentář byl moderátorem webu minimalizován
Ahoj Kathryn F,
Následující kód VBA vám může pomoci vyřešit problém. Zkuste to prosím. Děkuji za váš komentář.
Dim xRg As Range
'Update by Extendoffice 20221019
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
Set xRg = Intersect(Range("B:B"), Target)
If xRg Is Nothing Then Exit Sub
If Target.Value = "Y" Then
Call Mail_small_Text_Outlook
End If
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2"
On Error Resume Next
With xOutMail
.To = "Email Address"
.CC = ""
.BCC = ""
.Subject = "send by cell value test"
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub

Private Sub Worksheet_Calculate()
Dim xTarget As String
Dim xRg As Range
'Set xRg = Application.Range("B:B")
Set xRg = Intersect(Range("B:B"), Selection.EntireRow)
On Error GoTo Err01
If xRg.Value = "Y" Then
Call Mail_small_Text_Outlook
End If
Err01:
End Sub
Tento komentář byl moderátorem webu minimalizován
Dobrý den, děkuji vám za tuto lekci.
J'ai cependant une obtížné nalít l'application de la plage de recherche.
Dans le code, j'ai demandé à vérifier la plage C2:C4.
Tout fonctionne bien si je modifikován C2, C3 nebo C4 unikát. Cela fonctionne aussi si je modifie C2+C3+C4 ou C2+C3 ou C3+C4 mais cela ne fonctionne pas si j'ai un saut dans la plage. Příkladem může být modifikace C2 a C4 bez modifikátoru C3.
Est-ce que quelqu'un pourrait m'aider pour m'indiquer où se trouve mon erreur ?
Merci d'avance.

Soukromá dílčí tabulka_Změna (ByVal Target As Range)
'Aktualizováno Extendoffice 20220921
Ztlumit xAddress jako řetězec
Dim xDRg, xRgSel, xRg jako rozsah

xAddress = "C2:C4"
Nastavit xDRg = rozsah (xAddress)
Nastavit xRgSel = Intersect(Target, xDRg)
Při chybě Přejít na Err1
If Not xRgSel Is Nothing Then
If ThisWorkbook.gChangeRange = "" Pak
ThisWorkbook.gChangeRange = xRgSel.AddressLocal(False, False, xlA1, True, False)
Jiný
Nastavit xRg = Range(ThisWorkbook.gChangeRange)
Nastavit xRg = Application.Union(xRg, xRgSel)
ThisWorkbook.gChangeRange = xRg.AddressLocal(False, False, xlA1, True, False)
End If
End If
Konec Sub
Err1:
ThisWorkbook.gChangeRange = xRgSel.AddressLocal(False, False, xlA1, True, False)
End Sub


-----

Možnost explicitní
Veřejné gChangeRange jako řetězec
Private Sub Workbook_AfterSave (ByVal Success As Boolean)
'Aktualizováno Extendoffice 20220921
Dim xRgSel, xRg jako rozsah
Dim xOutApp jako objekt
Dim xMailItem jako objekt
Dim xMailBody jako řetězec
'Při chybě pokračovat dále
Při chybě Přejít na Err1
Nastavit xRg = Range(gChangeRange)
If Not xRg Is Nothing Then
Set xOutApp = CreateObject("Outlook.Application")
Nastavit xMailItem = xOutApp.CreateItem(0)
xMailBody = "Cher Jean-Marie, " & vbCrLf & vbCrLf & "Dans le fichier : " & ThisWorkbook.FullName & vbCrLf & "La plage de cellules a été modifiée :" & xRg.Address(False,CrLf) & vbL & "Srdeční"
S xMailItem
.To = "x.xxxxxx@xxxx.fr"
.Subject = "Données modifiées " & ThisWorkbook.Name
.Tělo = xMailBody
.Attachments.Add (ThisWorkbook.FullName)
.Zobrazit
Konec s
Nastavte xRgSel = Nic
Nastavte xOutApp = Nic
Nastavit xMailItem = nic
End If
Err1:
gChangeRange = ""
End Sub
Tento komentář byl moderátorem webu minimalizován
Chtěl bych poslat e-mail 5 lidem. Jaký oddělovač se používá mezi jednotlivými e-mailovými adresami?
Tento komentář byl moderátorem webu minimalizován
Ahoj Joe,
K oddělení e-mailových adres použijte středník.
Tento komentář byl moderátorem webu minimalizován
Tady je další otázka. Pokud se jedna buňka změní, odešle e-mail. pokud se změní 3 buňky, odešle 3 e-maily. Jak to zastavíte, aby se po dokončení úprav odeslal pouze 1 e-mail?
Tento komentář byl moderátorem webu minimalizován
Ahoj Joe,
Předpokládejme, že jste v kódu zadali rozsah jako "A2:E11". Jak mohu ověřit, že jsou všechny úpravy hotové?
Zatím zde nejsou žádné komentáře
Zanechat své připomínky
Odesílání jako host
×
Ohodnoťte tento příspěvek:
0   Postavy
Doporučená umístění

Sociální sítě

Copyright © 2009 - www.extendoffice.com. | Všechna práva vyhrazena. Poháněno ExtendOffice. | |. | Sitemap
Microsoft a logo Office jsou ochranné známky nebo registrované ochranné známky společnosti Microsoft Corporation ve Spojených státech a / nebo jiných zemích.
Chráněno Sectigo SSL