MS Excel

Zdravím, potřeboval bych pomoci s makrem, které vloží kontingeční tabulku do textu emailu.

Private Sub OdesliEmailReportu()
' odeslání vytvořeného reportu (KT1 - KT4)

Dim OutApp As Object, OutMail As Object
Dim strAdresat As String, strSubject As String, strBody As String

strAdresat = "adresaprijemce@neco.cz"
strSubject = "Report dne " & Format(Date, "d.m.yyyy")
strBody = "Zasílám vybrané tabulky:"

On Error Resume Next
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo 0

Set OutMail = OutApp.CreateItem(0)

With OutMail
.to = strAdresat
.Subject = strSubject
.body = strBody

.Display
End With

Set OutMail = Nothing
Set OutApp = Nothing

End Sub

KT je uložena na samostatném listu jako KT1
Díky za pomoc

Zaslat odpověď >

elninoslov(31.5.2024 18:35)#056580

Outlook už mi nefunguje ako kedysi, že stačilo iba vytvoriť inštanciu a poslalo to. Musím ho teraz vždy nechať zobraziť. Inak nič neodošle a čaká až na manuálne otvorenie. Takže takto to funguje aj na E2024.

Žiaľ, M$ znefunkčnieva zo starých dobrých časov všetko, čo sa dá... Robí to niekedy od januára tohto roku. Je založené aj vlákno na hromadnú sťažnosť na fóre M$.

Skúste.

Příloha: zip

56580_odoslat-kt-mailom.zip (27kB, staženo 3x)

citovat

Začátečník(3.6.2024 12:02)#056586

Tak jsem se konečně dostal k testu.
.InsertBreakvyhazuje chybu "Metoda nebo vlastnost není k dispozici, protože je dokument uzamčen pro úpravy."
Domnívám se, že je to "vlastnost" bezpečnostní politiky firmy.

Jediné kdy se mi podařilo vložit KT do textu je: Set WrdDoc = OutMail.GetInspector.WordEditor
shs_kt1.PivotTables("KT1").TableRange1.Copy
WrdDoc.Range.PasteSpecial
ale tam zase narážím na problém, že mi předchozí text vymaže a vkládá tak data "do čistého". Potřebuji vložit text a 4 KT pod sebe.

Spolehlivá metoda je vytvořit ze všech KT samostatný sešit a ten vložit jako přílohu - ovšem pak nesmí nikdo aktualizovat KT v této příloze, protože nenajde zdorj dat.

Jinak naprosto souhlasím s těmi super změnami v MSO u mě též podpořené bezpečnostní politikou. A to netuším co mě bude čekat při přechodu na W11...citovat

elninoslov(3.6.2024 14:16)#056590

A neprejde ani toto?
Set WrdDoc = .GetInspector.WordEditor
With WrdDoc.Content
.Collapse Direction:=wdCollapseEnd
' .Paragraphs.Add
.InsertBreak

ThisWorkbook.Worksheets("KT1").PivotTables("KT1").TableRange1.Copy
' Application.Wait Now() + TimeValue("00:00:01")
.PasteSpecial DataType:=10, Link:=False
.InsertBreak
Application.CutCopyMode = False

ThisWorkbook.Worksheets("KT2").PivotTables("KT2").TableRange1.Copy
' Application.Wait Now() + TimeValue("00:00:01")
.PasteSpecial DataType:=10, Link:=False
.InsertBreak
Application.CutCopyMode = False

ThisWorkbook.Worksheets("KT3").PivotTables("KT3").TableRange1.Copy
' Application.Wait Now() + TimeValue("00:00:01")
.PasteSpecial DataType:=10, Link:=False
.InsertBreak
Application.CutCopyMode = False

ThisWorkbook.Worksheets("KT4").PivotTables("KT4").TableRange1.Copy
' Application.Wait Now() + TimeValue("00:00:01")
.PasteSpecial DataType:=10, Link:=False
Application.CutCopyMode = False
End With

.Display
To .Collapse to tam musí byť, inak nezachová text pred KT.
To .InsertBreak tam byť nemusí, pôjdu tie KT hneď pod sebou.
Tá pauza tam bola pre istotu, ak je väčšia KT, aby stihla systémová Copy urobiť všetko čo potrebuje.citovat

Začátečník(4.6.2024 6:46)#056591

Díky, tak tohle zabralo.
A pokud by bylo nutné přidat text ještě za KT jakým příkazem?
.InertAfter "text"citovat

Téma: KT jako text do emailu

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje