Zkusil bych to přes soubor.
Nejprve data uložit do souboru a ten pak otevřít v NotePadu.
Např.:
Sub CopyToNotepad(strText as String)
Dim objFSO As Object
Dim objFile As Object
' Vytvoření objektu FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Vytvoření a otevření textového souboru
Set objFile = objFSO.CreateTextFile("C:\Temp\output.txt", True)
' Zapsání textu do souboru
objFile.WriteLine strText
' Zavření souboru
objFile.Close
' Otevření Notepadu s vytvořeným souborem
Shell "notepad.exe C:\Temp\output.txt", vbNormalFocus
End Sub
Díky, tak tohle zabralo.
A pokud by bylo nutné přidat text ještě za KT jakým příkazem?
.InertAfter "text"
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...
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
Jediné co mne narychlo napadá je jednorázově spustit:
Sub Email()
Dim hodnota As String
Dim i As Long
With List1
For i = 5 To .Cells(Rows.Count, 1).End(xlUp).Row
hodnota = .Cells(i, 2)
If hodnota <> Empty Then
.Hyperlinks.Add .Cells(i, 2), "mailto:" & hodnota
End If
Next i
End With
End Sub
PavDD napsal/a:
If konecForm Then 'MsgBox "zmačknul jsi storno"
Exit For
GoTo konec
End If
Ne to nestačí a navíc by to skončilo chybou.
...Nyní , když stisknu Storno, stejně to čeká ...na pozadí až to odpočítá temch 5 sec....
...Možná by pomohlo obecně vysvětlit, jak funguje v obecném formuláři tlačítko Storno, a tl Přerušit. Přerušit taky ukonší chod makra?...
...A ještě jeden dotaz, lze schovat křížek v pravém rohu formuláře?...
Dík za upozornění.
Chyba při použití přepisu do EN verze (používám záznam makra k získání EN vzorce).
EN: =IF(F10<DATE(YEAR(TODAY()),7,20),"20.07."&YEAR(TODAY()),"20.07."&YEAR(TODAY())+1)
Já to pochopil tak, že když je aktuální datum menší než požadovaný, tak je výsledek 20.7. aktuálního roku a po dosažení datumu 20.7. se zvýší o 1 rok.
Tedy dle Vašeho vzorce:
CZ: =DATUM(ROK(F10)+(F10>DATUM(ROK(F10);7;20));7;20)
EN: =DATE(YEAR(F10)+(F10>DATE(YEAR(F10);7;20));7;20)
ale je to "jen" o znaménku +/- ve vzorci.
Použít vyhodnocení stavu buňky F10 např.:
CZ: =KDYŽ(F10<DATUM(ROK(DNES());7;20);"20.07."&ROK(DNES());"20.07."&ROK(DNES())+1)
EN: =IF(F10<DATE(YEAR(TODAY()),7,20),""20.07.""&YEAR(TODAY()),""20.07.""&YEAR(TODAY())+1)
Pomocný sloupec O bude obsahovat součet všech hodnot požadovaných v buňce F6, pro O3=L3+M3+N3
buňka F6 pak bude mít vzorecCZ: =SVYHLEDAT(E6;K:O;5;0)
EN: =VLOOKUP(E6;K:O;5;0)
Více https://support.microsoft.com/cs-cz/office/svyhledat-funkce-0bbc8083-26fe-4963-8ab8-93a18ad188a1
Pokud jsem to pochopil správně, pak např.:
buňka E6CZ: =DATUM(ROK(DNES());12;31)
EN: =DATE(YEAR(TODAY()),12,31)
buňka F6CZ: =SVYHLEDAT(E6;K:L;2;0)
EN: =VLOOKUP(E6;K:L;2;0)
Použijte
Sub vlastnizahlavi()
Dim poznamka As String
poznamka = InputBox("Zadej vlastní záhlaví :", "OKNO", "")
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = "Text 123456 + : " & poznamka
.RightHeader = ""
End With
End Sub
"Scraper" napsal/a:
...Existovala by prosím , možnost jak list PLAN , kde se tvoří úkony trochu ulehčit ?...
Narychlo - modul PlanCinnosti
Problém je, že v kartách listů máte odkazy do listu plánu. To mi moc smyslu nedává, protože listy strojů by měly obsahovat data a ne odkazy na jiné listy.
Chtělo by to pak sjednotit i list číselník podle skutečných Karet strojů a z něj pak načítat do listboxu (taky upraveno načítání při inicializaci formuláře).
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
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.