• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

MS Excel

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

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

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

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

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

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

Děkuji.
Obsah bych také uvítal, ale není nijak extra důležitý.citovat

Palooo(4.7.2014 9:58)#020355

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

Trochu jsem se v tom ztratil. Můžete mi to popsat trošku konkrétněji?citovat

Ilendor(4.7.2014 13:50)#020357

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

toto ste zabudli doplnit:
Sub Mail_small_Text_Outlook(byval aValue as string)citovat

Ilendor(4.7.2014 15:21)#020361

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

Strana:  1 2   další »

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse