< návrat zpět

MS Excel

Téma: MAKRO - Vypsání adresy buňky rss

Zaslal/a Ilendor 4.7.2014 8:12

Dobrý den.

Potřeboval bych poradit, jak vypsat adresu buňky pomocí makra.

Konkrétněji: Dal jsem s pomocí strýčka Googlu dohromady makro, které mi při změně buňky v dané oblasti odešle e-mail. Nyní bych do textu tohoto e-mailu potřeboval dostat výše zmíněnou adresu 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.

Díky předem za pomoc.

Zaslat odpověď >
Strana:  1 2   další »
Palooo(4.7.2014 8:39)#020348
avatar
do daneho sheetu dopiste event:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) = "A10" Then Call EmailMacro
End Subcitovat
Ilendor(4.7.2014 9:14)#020349
avatar
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.citovat
Ilendor(4.7.2014 9:20)#020350
avatar
Přičemž chci, aby se automaticky doplnila adresa změněné buňky v zadaném rozmezí A1:HB100citovat
Palooo(4.7.2014 9:25)#020352
avatar
OPRAVA

prepiste to takto:

Call Mail_small_Text_Outlook Target.Address(0, 0)
a
Sub Mail_small_Text_Outlook(byval aValue as string)
...
strbody = "Změnila se buňka: " & aValue
...

a obsah nechcete vediet?citovat
Ilendor(4.7.2014 9:40)#020354
avatar
Děkuji.
Obsah bych také uvítal, ale není nijak extra důležitý.citovat
Palooo(4.7.2014 9:58)#020355
avatar
netusim v akom formate by mal byt vystup tak len takto:

prepiste tu prvu cast na toto:
Call Mail_small_Text_Outlook Target.Address(0, 0)
na: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) citovat
Ilendor(4.7.2014 13:18)#020356
avatar
Trochu jsem se v tom ztratil. Můžete mi to popsat trošku konkrétněji?citovat
Ilendor(4.7.2014 13:50)#020357
avatar
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)citovat
Palooo(4.7.2014 13:59)#020358
avatar
toto ste zabudli doplnit:
Sub Mail_small_Text_Outlook(byval aValue as string)citovat
Ilendor(4.7.2014 15:21)#020361
avatar
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... 8

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?citovat

Strana:  1 2   další »

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