Příspěvky uživatele
< návrat zpět
Opraveno na:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Dim x As String
Set KeyCells = Range("A1:HB100")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
For x = 0 To UBound(Target.Cells.Value)
aValue = aValue & ";" & Target.Cells(x).Value
Next
Call Mail_small_Text_Outlook aValue & " Range: " & Target.Address(0, 0
End If
End Sub
Sub Mail_small_Text_Outlook(ByVal aValue As String)
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
For Each cell In ThisWorkbook.Sheets("List1").Range("A1:HB100")
strbody = "Změnila se buňka" & aValue
Next
On Error Resume Next
With OutMail
.To = "@"
.CC = ""
.BCC = ""
.Subject = "Změny v tabulce"
.Body = strbody
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
A stále nic... 
Mohl bych Vás poprosit o kontrolu celého kódu a o zveřejněné celého kódu, který jsem výše vypsal s vašimi úpravami?
Musím si x nadefinovat jako proměnnou?
Jsem začátečník, který programoval jen Karla a něco málo v Pascalu... Z toho, co jste mi napsal jsem dal dohromady toto:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Dim x As String
Set KeyCells = Range("A1:HB100")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
For x = 0 To UBound(Target.Cells.Value)
aValue = aValue & ";" & Target.Cells(x).Value
Next
Call Mail_small_Text_Outlook
End If
End Sub
Sub Mail_small_Text_Outlook()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
For Each cell In ThisWorkbook.Sheets("List1").Range("A1:HB100")
strbody = "Změnila se buňka" & aValue
Next
On Error Resume Next
With OutMail
.To = "@"
.CC = ""
.BCC = ""
.Subject = "Změny v tabulce"
.Body = strbody
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Ale mám obavy, že jsem špatně zadefinoval X a dál se nemůžu pohnout. Pokud použiji v první části (vyvolání makra změnou buňky) Call Mail_small_Text_Outlook aValue & " Range: " & Target.Address(0, 0) tento kód, vyhodí mi syntax error...
Výstupem by měl být e-mail v tomto tvaru:
Dobrý den, změnila se buňka (Adresa buňky) na hodnotu (Nová hodnota)
Trochu jsem se v tom ztratil. Můžete mi to popsat trošku konkrétněji?
Děkuji.
Obsah bych také uvítal, ale není nijak extra důležitý.
Přičemž chci, aby se automaticky doplnila adresa změněné buňky v zadaném rozmezí A1:HB100
No, to není úplně to, o čem jsem mluvil.
Kód viz níže.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("A1:HB100")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
Call Mail_small_Text_Outlook
End If
End Sub
Sub Mail_small_Text_Outlook()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
For Each cell In ThisWorkbook.Sheets("List1").Range("A1:HB100")
strbody = "Změnila se buňka"
Next
On Error Resume Next
With OutMail
.To = "@"
.CC = ""
.BCC = ""
.Subject = "Změny v tabulce"
.Body = strbody
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Místo "Změny v tabulce" potřebuji vypsat adresu změněné buňky.
Např. pokud změním buňku A10, chci aby se odeslal e-mail s textem: Hodnota buňky A10 se změnila.
Uživatelské menu
\nMenu
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.
RSS nejnovější články