Příspěvky uživatele

Díky, funguje bezvadně.
Tu vychytávku s PROČISTIT oddělávám, abych vzorci ulehčil, ale vidět, že myslíš na všechno.

Dík Lubo,
přiznám se, že se mi to ještě nepovedlo. Zkoušel jsem SUMIFS, ale pořád mi to vrací nulu.
V dalším kroku bych mohl porovnat, který vzorec je vhodnější , ale momentálně bych uvítal alespoň jeden funkční vzorec.

Na to XLOOKUP se jdu podívat...

Ahoj,
potřeboval bych sčítat čísla za konkrétní osobu a konkrétní období. Pro vzorečkáře to bude zřejmě triviální úkol, mým cílem je co nejmíň výsledný soubor výpočetně zatížit, neboť tento vzorec se tam bude vyskytovat stokrát (plus spousta jiných vzorečků). Tedy nevím, jestli se excel víc trápí s maticovými vzorci, s klasickýmo SUMIFS anebo přes INDEX / POZVYHLEDAT. Pokud by byla výhodnější architektura pootočená o 90° (datumy v řádku), tak teď to ještě můžu změnit. Ilustrační příklad v příloze
Předem moc dík

Tak jsem si na helpdesku vyjednal odklad restrikcí o 4 týdny. Ale pak už žádný příkaz typu Shell nebo cmd z VBA nebude možné spustit

Mezitím na něco snad přijdu...

Věděl by někdo jakým příkazem lze z VBA vytisknout PDF dokument, když vím jeho plnou cestu? Otestuju, zdali by to fungovalo pod restrikcemi. Doteď jsem to dělal takhle, ale to už neprojde:
Sub Tisk_PDF_0(StrPDFFile As String)
Dim StrProgram As String
StrProgram = "C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe "
If StrPDFFile Like "*.pdf" Then
Shell """" & StrProgram & """/n /h /t""" & StrPDFFile & """"
End If
'Zavři PDF
TaskKill ("AcroRd32.exe")
End Sub

Ahoj, mám dost velký problém. Na firemní síti se od minulého týdne projevily restrikce, které blokují některé příkazy volané z VBA. Např. tento kód
Sub test_003()
Dim strPrikaz As String
strPrikaz = "Ping 10.161.10.152"
Call Shell("cmd.exe /s /k " & strPrikaz, vbNormalFocus)
End Sub
se mimo firemní síť provede, ale v naší síti to zablokuje Firewall s hláškou: "Zabezpečení windows zablokovalo tuto akci protože to tak nastavil váš správce sítě. Obraťte se na helphesk". Ten Ping je jenom triviální příklad, ve skutečnosti spouštím externí program s předanými parametry. Pokud si otevřu CMD ručně a vložím tam příslušný string, tak se příkaz v pohodě vykoná i ve firemní síti.

Potřeboval bych nouzově pro úplně neznalé uživatele alespoň otevřít kódem prázdné okno CMD, ale nějak se nemůžu dogooglit jak na to.
Stres, konec měsíce, prosím o nakopnutí

Tento XML soubor je řídící "matricí" systému údržby obráběcího stroje. Obsahuje však nějaké chyby nebo nepřesnosti, které bych potřeboval změnit a pak tento editovaný XML nahrát zpět do stroje.
Takže všechno jde fajn až do tohoto momentu: "a môžem si zmeniť aj uložiť čo chcem". Tedy změnit můžu, ale už to zpět jako xml soubor neuložím, bo vyskočí hláška:
"Nelze uložit či exportovat data XML. Mapování XML v tomto sešitu není možné exportovat".

Po kliknutí na Nápovědu mě to vede na kartu Vývojář, kde po kliknutí na Export dostávám stejnou hlášku, takže nevidím možnost jak to uložit/exportovat jako nový soubor ve formátu XML.
Když na Vývojář -> Zdroj úplně dole kliknu na link Ověřit mapu pro export, tak se objeví hláška: "Machine_Mapování nelze exportovat, protože obsahuje následující:
* Seznam seznamů
* Nenormalizovaná data
* Namapovanou relaci prvku s jinými prvky nelze zachovat"

Ve Zdroj dat XML vypadají všechna pole jako namapované, tedy po kliknutí na každý prvek se mi na listě vybere příslušný namapovaný sloupec. Tož nevím co s tím

Včera mi to nevzalo xml přílohu, což jsem si nevšiml. Takže jsem ji zazipoval a přidal k včerejšímu příspěvku

Ahoj, tak to mně zajímá.
V příloze je soubor xml, který dovedu otevřít excelem, ale při tom se mně to ptá jestli to chci otevřít jako tabulku XML, nebo jako sešit jen pro čtení anebo použít podokno úloh. Nevím, tak volím první možnost, excel hlásí, že vytvoří schéma. Pak se ten soubor otevře v krásné tabulkové podobě. Ale když tam pozměním nějaká data (třeba výrobní číslo v prvním sloupci), tak už mi to nejde uložit jako nový soubor xml, hláška je: Nelze uložit či exportovat data XML. Mapování XML v tomto sešitu není možné exportovat.
Co dělám blbě anebo jak to udělat správně?

Ahoj vespolek,

Ohledně automatického zálohování (abychom neztratili neuloženou práci) už zde příspěvek byl, ale toto je něco jiného. Už roky používám u důležitých souborů, (kde to má význam) cyklické zálohování. Určím, že v určitém adresáři bude n (10 nebo klidně i 100) záloh, které se budou cyklicky přepisovat (tedy vždy ta nejstarší záloha), pokud od času uložení poslední zálohy uplyne jistý čas (např. 2 hod nebo 2 dny).
Jaký to má význam? Třeba po čase zjistím, že mi někdo (nebo třeba i já) omylem něco smazal nebo pozměnil. Tak jdu do seznamu záloh a tam to najdu ještě v původním stavu a mám to podle čeho obnovit - pokud mám správně zvolený ukládací interval a počet záloh. Procedura se sama spouští při otevírání souboru (v některých případech i při zavírání). Už mi to párkrát významně pomohlo, tak třeba se to někomu hodí...
Sub ZalohaSouboru()
'na definovaném místě vytvoří n záložních souborů a do toho nejstaršího vždy uloží aktuální zálohu
'zálohu to vytváří pouze pokud od datumu/času poslední uložené zálohy uplynula nějaká doba
'tato časová konstanta (sgInterval) je v této proceduře nastavena na 2 dny (48 hodin)

Const n As Integer = 9 'n = počet záložních souborů, které budeme používat
Const sgInterval As Single = 2 '2 dny = 48 hodin. Tím pádem hloubka historie je n * sgInterval = 9 * 2 = 10 dnů

Dim strNazev As String, strPath As String, strName As String
Dim dDatum As Date, dDatum_Max As Date, dDatum_Min As Date
Dim i As Integer, iNejstarsi As Integer, iNejmladsi As Integer
Dim Cas As Double, Rozdil As Double
Dim boVytvoreno As Boolean

'pokud je soubor jen pro čtení, přeskoč tvorbu zálohy
If ThisWorkbook.ReadOnly = True Then
MsgBox "Tento soubor je otevřen jen pro čtení, takže nebudu vytvářet zálohu"
Exit Sub
End If

'název tohoto souboru
strName = ThisWorkbook.Name
'odřezat příponu
strName = Left(strName, Len(strName) - 5)
'cesta, kam se budou ukládat zálohy
strPath = ThisWorkbook.Path & "\MojeVykazy\Zalohy\"

'kdybychom otevírali záložný soubor, ať se nic neděje
If Left(strName, 4) = "Zal_" Then Exit Sub

'nejdřív zkontrolujeme, jestli adresář pro zálohy existuje, pokud ne, tak ho vytvoř
If Dir(strPath, vbDirectory) = "" Then
MkDir strPath
End If

'teď zkontrolujeme, zdali zálohy existují. Pokud ne, tak je rovnou vytvoř
For i = 1 To n
strNazev = strPath & "Zal_" & strName & "_" & i & ".xlsm"
If Dir(strNazev) = "" Then
'nápis ve stavovém řádku
Application.DisplayStatusBar = True
Application.StatusBar = "Vytvářím soubor zálohy: " & "Zal_" & strName & "_" & i & ".xlsm"
'vytvoř číslovaný soubor zálohy
ThisWorkbook.SaveCopyAs strPath & "Zal_" & strName & "_" & i & ".xlsm"
boVytvoreno = True
End If
Next i

If boVytvoreno Then GoTo FiNito 'pokud jsi vytvářel nějaký chybějící soubor zálohy, tak není nutné pokračovat

dDatum_Max = Now()
dDatum_Min = 0

'nazev založního souboru bez indexu a přípony
strName = ThisWorkbook.Name
strName = "Zal_" & Left(strName, Len(strName) - 5)

'tento cyklus projede všechny očíslované záložné soubory a zjistí _
který je nejstarší a nejmladší
i = 1
Do
strNazev = strPath & strName & "_" & i & ".xlsm"
If Dir(strNazev) = "" Then Exit Do
dDatum = FileDateTime(strNazev)

If dDatum < dDatum_Max Then
If dDatum > dDatum_Min Then
dDatum_Min = dDatum
iNejmladsi = i
End If
dDatum_Max = dDatum
iNejstarsi = i
Else
If dDatum_Min < dDatum Then
dDatum_Min = dDatum
iNejmladsi = i
End If
End If
i = i + 1
Loop

'kdyby nebyl nalezen žádný takový soubor, dej hlášku
If i = 1 Then
MsgBox "na místě " & strPath & vbCr _
& " nebyly nalezeny soubory záloh"
Exit Sub
End If

'Nastavení minimálního intervalu zálohování 1 = 1 den
'porovnáme čas uložení nejmladšího a nynější čas
Cas = CDbl(FileDateTime(strPath & strName & "_" & iNejmladsi & ".xlsm"))
'zjisti rozdíl časů
Rozdil = Round(CDbl(Now) - Cas, 2)

'nápis ve stavovém řádku
Application.DisplayStatusBar = True
Application.StatusBar = "Poslední záloha byla uložena před " & 24 * Rozdil & " hod"

If Rozdil > sgInterval Then
'přepiš nejstarší zálohu
ThisWorkbook.SaveCopyAs strPath & strName & "_" & iNejstarsi & ".xlsm"
End If

FiNito:
'vrátime excelu kontrolu nad stavovým řádkem
Application.StatusBar = False
On Error GoTo 0

End Sub

Dá se to udělat nepřímo ignorováním chyby a pak jejím zpětným vyhodnocením.
Nejdřív si zjisti číslo chyby, co to vyhodí v případě, že je ten soubor používán.

Před "problémový" řádek kódu napiš
On Error Resume Next
tady bude kód pro otevření texťáku
A pak zkoumej, jestli ta chyba nastala:
If Err = 1234 then
Msgbox "Soubor je používán, procedura bude ukončena"
Exit Sub
ElseIf Err <> 0 then
Msgbox "Jiná chyba"
Exit sub
End If
On Error GoTo 0

Ale nevím o tom, že by soubor s příponou .txt byl nějak zablokovaný (na rozdíl od pdf, atd).
Napiš ten kód, co vyhazuje chybu

Ten uvedený kód pracuje s adresářovou strukturou Windows, kde jsou úrovně složek oddělovány zpětným lomítkem. Mám nejasné tušení, že Macbook používá normální lomítko.
Zkus v kódu nahradit \ za / a krokuj to pomocí F8 a v Locals Window si kontroluj hodnoty proměnných - takhle poznáš kde je problém

Pole s povolenými znaky je v tomto případě zbytečná technika, použil jsem to z existující funkce co používám pro nahrazování diakritiky. Pro účely RZ to plně postačí takto:
strPovoleneZnaky = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"

'kontrola na povolené znaky (abecedu a číslice)
For x = 1 To Len(kj)
'znak po znaku se bude zkoumat jestli je ze seznamu (pole) povolených znaků
strX = Mid(kj, x, 1)
If InStr(1, strPovoleneZnaky, strX) = 0 Then
MsgBox strX & " není povolený znak pro SPZ!"
Exit Sub
End If
Next x

Nahraďte část svého kódu (po loop) tímto:
Sub Nova_KJ()

Dim kj As String
Dim jmeno As String, strX As String
Dim radek As Long, x As Integer, m As Integer
Dim aPovoleneZnaky As Variant
Dim boNalezeno As Boolean

aPovoleneZnaky = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "1", "2", "3", "4", "5", "6", "7", "8", "9", "0")

On Error Resume Next 'pokud uživatel stiskne klávesu ESC, kód skočí do řádku s "Exit Sub"

kj = InputBox("Zadejte novou RZ: (bez mezer, a speciálních znaků) - ukončit můžete klávesou ESC nebo kliknutím na křížek nebo na klávesu Cancel")

If Err.Number <> 0 Then 'pokud uživatel stiskne klávesu ESC, ukončí se makro
Exit Sub
End If

If kj = "" Then
Exit Sub
End If

'převeď to na velké a odstřel případné mezery
kj = Trim(UCase(kj))

'kontrola na počet znaků
If Len(kj) < 7 Then
MsgBox kj & vbCrLf & "to je příliš málo znakú pro RZ"
Exit Sub
End If

If Len(kj) > 7 Then
If vbNo = MsgBox(kj & vbCrLf & "Příliš mnoho znakú pro RZ!" & vbCrLf & "opravdu pokračovat?", vbYesNo) Then Exit Sub
End If

'kontrola na povolené znaky (abecedu a číslice)
For x = 1 To Len(kj)
'znak po znaku se bude zkoumat jestli je ze seznamu (pole) povolených znaků
strX = Mid(kj, x, 1)
boNalezeno = False
For m = LBound(aPovoleneZnaky) To UBound(aPovoleneZnaky)
If aPovoleneZnaky(m) = strX Then
boNalezeno = True
Exit For
End If
Next m
If boNalezeno = False Then
MsgBox strX & " není povolený znak pro SPZ!"
Exit Sub
End If
Next x

If Sheets("kj").Range("A2") = "" Then
radek = 2
Else
radek = Sheets("kj").Range("A" & Rows.Count).End(xlUp).Row + 1
End If
Sheets("kj").Range("A" & radek).Value = kj

tato podmínka je špatně:
If Not (IsUpper(kj) And _
IsNumeric(kj) And _
Len(kj) = 7 Or Len(kj) = 0 Or Len(kj) < 7) Then

za prvé kontrolovat velká malá písmena je zbytečná buzerace uživatele, u SPZ to kódem změňte na UCASE, u jména první velké a ostatní LCASE. Ale problém je IsNumeric(kj), což v případě SPZ nebude nikdy splněno

Tak jsem nakonec vygooglil kód, kterým se "plevelné" oblasti smažou:
Sub DeleteAllSheetNames()
Dim n As Name
For Each n In ThisWorkbook.Names
If Not n.Parent Is ThisWorkbook Then n.Delete
Next
End Sub

Příspěvky uživatele

Uživatelské menu

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura IV

Aktivní diskuse

Relativní cesta - zdroje Power Query

Vyhledej

Vyhledej

Vyhledej

Relativní cesta - zdroje Power Query

Relativní cesta - zdroje Power Query

Relativní cesta - zdroje Power Query