< návrat zpět

MS Excel


Téma: KT jako text do emailu rss

Zaslal/a 31.5.2024 11:06

ZačátečníkZdraví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

Jméno
Kontrola
Text
  b i u s img code url hr   1 2 3 4 5 6 7 8 9 10

#056580
elninoslov
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: zip56580_odoslat-kt-mailom.zip (27kB, staženo 3x)
citovat
#056586
Začátečník
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
#056590
elninoslov
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
#056591
Začátečník
Díky, tak tohle zabralo.
A pokud by bylo nutné přidat text ještě za KT jakým příkazem?
.InertAfter "text"citovat

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