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

Příspěvky uživatele

@elninoslov
Mohu se, prosím, zeptat, jako lama...?
Kde v tom kódu je ta instance, která určí, na které tlačítko jsem kliknul?
Děkuji. Radek
Sub FindDict()
Dim Typ As Byte, Count As Long, i As Long
Dim D(), R(), H()
Dim FindVal As String

Typ = Split(Application.Caller, " ")(1)

With Worksheets("dictionary").ListObjects("DataDictionary")
H = .HeaderRowRange.Value
D = .DataBodyRange.Value
ReDim R(1 To UBound(D, 1), 1 To 2)
End With

Application.ScreenUpdating = False

With Worksheets("find")
.Range("A4:B4").Value = Array(H(1, Typ), H(1, 2 - Typ + 1))

FindVal = .Range("A2").Value2
If FindVal = "" Then MsgBox "Zadejte hledaný výraz", vbExclamation: GoTo FINAL

For i = 1 To UBound(D, 1)
If InStr(1, D(i, Typ), FindVal, vbTextCompare) > 0 Then
Count = Count + 1
R(Count, 1) = D(i, Typ)
R(Count, 2) = D(i, 2 - Typ + 1)
End If
Next i

i = .Cells(Rows.Count, "A").End(xlUp).Row - 4

With .Range("A5:B5")
If Count = 0 Then
If i > 0 Then .Resize(i).ClearContents
Else
If i > Count Then .Offset(Count).Resize(i - Count).ClearContents
.Resize(Count).Value2 = R
.Resize(Count, 1).Font.Bold = True
End If
End With
End With

FINAL:
Application.ScreenUpdating = True
End Sub

Dobrý, tedy.
Poslal jsem příspěvek ;-)

@elninoslov
klaním se mistrovi
Ta verze s makrem...SUPER, díky moc.
Pokud mám zase přispět na podporu fóra, rád to udělám ;-)

Dobrý den, chtěl požádat o pomoc s makrem, makry pro hledání na listu "dictionary", kde jsou data ve formátu Tabulky s názvem "DataDictionary".
Chtěl bych, aby na listu "find" se do buňky "A2" zadal hledaný výraz, alespoň 2 písmena.
A pak by se podle kliknutí na příslušné tlačítko hledalo na listu "dictionary".
Pokud bych klikl na tlačítko "CZ --> EN" tak by se do buňky "A4" na listu "find" napsalo záhlaví z buňky "A1" z listu "dictionary" a do buňky "B4" záhlaví z buňky "B1" na listu "dictionary.
A pokud by se našla shoda se zadaným výrazem v buňce "A2", vypsaly by se všechny "nálezy" od řádku 5 na listu "find".
Písmo ve sloupci "A" na listu "find" by bylo tučně.
A analogicky by to bylo při použití tlačítka "EN --> CZ", akorát do buňky "A4" na listu "find" by se napsalo záhlaví z buňky "B1" z listu "dictionary"
Děkuji.
Radek

jj, to je pak peklo
Díky

Omlouvám se, ach jo, jsem lama.
To by se teta v Prochote divila, že nerozumím slovensky

Tyto dva vzorce nefungují:
=IFERROR(INDEX(DataDopln[text];MATCH("*";IFERROR(""&MATCH(DataDopln[cislo];[@[Číslo účtu ]];0);FALSE);0));"")

=IFERROR(INDEX(DataDopln[text];MATCH(1;COUNTIF([@[Číslo účtu ]];DataDopln[cislo]);0));"")

Každopádně děkuji.
Radek

@Jiří497
Jj, to funguje, ale není to úplně "universální", protože, kdybych potřeboval například hledat navíc například "08????", musel bych editovat vzorec.
U některých syntetických účtů dosazuji podle prvních 2 znaků, někdy podle prvních 3 a někdy mohu dosazovat i jen podle 1 znaku.

@lubo
můj excel tu fci FILTER nezná, nebo já jsem úplná lama

@elninoslov
ani jedna ta funkce mi neukáže výsledek. všude mám prázdné buňky.
S tím počtem znaků jsem se ukliknul

Převedl jsem nyní zdrojová data a data na listu na doplnění na formát Tabulka, ten používám většinou s ohledem na měnící se rozsahy dat.
Můžete se na to prosím podívat?
Děkuji všem.
Radek

Dobrý den, mohl byste mi někdo poradit se zástupnými znaky při využití u fce SVYHLEDAT?
Jakým způsobem bych mohl použít zástupný znak "*" nebo "?" nebo nějaký jiný tak, abych:
Na listu "list2" doplnil do sloupce "dopln" hodnotu z tabulky na listu "dopln" z druhého sloupce.
Vím, že data na listu "list2" je ve sloupci "A" počet znaků 6.
Je to nějak řešitelné pouze přes funkci?
Děkuji.
Radek

EDIT
Tak když se soubor vyexportuje z Informačního systému na počítači s win, tak vše funguje korektně.
Pokud však kolega exportuje soubor z Informačního systému na Mac tak to nefunguje.
Po exportu na Mac ten vyexportovaný soubor ani neotevře, ale jen ho zkopíruje na počítač s win a pak ho chce načíst, tak to nefunguje.
Takže to bude vše dělat na počítači s win a je to.
__________________
Díky za info.
Jenže mě to někdy nejde ani na windows a ukazuje mi to chybu na tomto řádku
If FileDateTime(sDir & sFileTemp) > dFileTime Then
a vůbec netuším, čím to je?
Musí tam tento řádek být, nedalo by se to nějak eliminovat?
Myslel jsem, že to mohlo být i nějakou diakritikou v názvech souborů nebo tak, ale fakt nevím.
Ten Mac už řešit nebudu, kolega si to může spustit na win.
Přikládám zdroje.
Děkuji.
Radek

Dobrý den,
prosím, můžete mi někdo poradit (zeditovat), proč se nenajde na MacBook ten soubor uložený v adresáři "data-platby"?
Adresář je uložen ve stejném adresáři, jakou sešit, ve kterém spouštím to makro.
Na WIN to funguje velmi dobře od doby, kdy mi to pomohl @elninoslov napsat.
Děkuji.
Radek
Sub doPDF_bezCOPY_proHS_adresář()

Dim sDir As String, sSoubor As String, sDate As String, sKod As String, MAIL_ADRESAT As String
Dim bTypSpravy As Byte, bOteviranyOutlook As Boolean, MyDate As Date
Dim OutApp As Object, OutMail As Object ', oUcet As Object

'Const ODESILATEL_MAIL = "elninoslov@gmail.com" 'v případě vícero účtů v Outlooku se bude odesílat z tohoto
Const ZAVRIT_OUTLOOK = True 'v případě, že Outlook otevře makro, má ho pak zavřít (True) nebo nechat otevřen (False)
Const ODESLAT_MAIL = False 'True - mail odešle, False - mail pouze vytvoří


'příprava adresáře

With ThisWorkbook.ActiveSheet 'toto pracuje s aktuálním Listem

sKod = .Range("B2").Value2 'kód hospodářského střediska
sDir = ThisWorkbook.Path & "\Export\" & sKod & "\" 'nastavení adresáře referenta do složky Export

'sDir = ThisWorkbook.Path & "\__pdfhs - " & sKod & "\" 'nastavení adresáře hospodářského střediska

'sDir = ThisWorkbook.Path & "\__pdfhs\" 'původní nastavení do přímo zvoleného adresáře

If Len(Dir(sDir, vbDirectory)) = 0 Then 'kontrola existence adresáře hospodářského střediska
If MsgBox("Adresář neexistuje." & vbNewLine & vbNewLine & "Přejete si ho vytvořit?" & vbNewLine & vbNewLine & sDir, vbYesNo + vbQuestion) = vbNo Then Exit Sub
If Not Vytvor_Adresarovou_Strukturu(sDir) Then bTypSpravy = 1: GoTo KONEC 'chybová správa o vytváření adresáře
End If

sDate = Format(Date, "yyyy-mm-dd") 'Rozhoduje pořadí, bere se ta poslední varianta, řádek

'příprava souboru

On Error Resume Next

'MAIL_ADRESAT = "niekto@odniekial.com" 'konkrétní adresát
MAIL_ADRESAT = "" 'adresát je prázdný

'MAIL_ADRESAT = .Range("B5").Value2 'adresát z konkrétní buňky, nebo adresáti v buňce oddělení středníkem

sSoubor = sDir & .Range("B1").Value2 & "-" & .Range("A1").Value2 & " _ " & sKod & ".pdf" 'složí název souboru
'sSoubor = sDir & sDate & " - " & sKod & " - " & .Name & ".pdf" 'složí název souboru
.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=sSoubor, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False 'export do PDF
End With

If Err.Number <> 0 Then bTypSpravy = 2: GoTo KONEC 'chybová správa o vytváření souboru

'příprava Outlooku

'Set OutApp = GetObject(, "Outlook.application") 'ověření, zda není Outlook otevřený

'If OutApp Is Nothing Then
'Set OutApp = CreateObject("Outlook.Application") 'otevření Outlooku, pokud není otevřen
'If Not OutApp Is Nothing Then bOteviranyOutlook = True Else bTypSpravy = 3: GoTo KONEC 'chybová správa o otvírání Outlooku
'End If
'On Error GoTo 0

'For Each oUcet In OutApp.Session.Accounts 'v případě vícero účtů v Outlooku, nalezení toho, z kterého se má odesílat
' If oUcet.CurrentUser.Address = ODESILATEL_MAIL Then Exit For
'Next oUcet

'If oUcet Is Nothing Then bTypSpravy = 4: GoTo KONEC 'chybová správa - požadovaný účet není v Outlooku nalezen


'příprava mailu

'On Error Resume Next
'Set OutMail = OutApp.CreateItem(0) 'vytvoření emailu
'With OutMail
' .To = MAIL_ADRESAT 'adresát
' .CC = ""
' .BCC = ""
' .Subject = "Pohledávky po splatnosti HS " & sKod
' .Body = "Posíláme pohledávky po splatnosti pro HS " & sKod
'.Attachments.Add sSoubor
'Set .SendUsingAccount = oUcet 'Odesílá pomocí zvoleného účtu

'If ODESLAT_MAIL Then .Send 'Else .Display 'podle volby se mail odešle (True), nebo pouze vytvoří (False)
'End With
'If Err.Number <> 0 Then bTypSpravy = 5
'On Error GoTo 0

'vyhodnocení

KONEC:
'AppActivate ThisWorkbook.Windows(1).Caption

Select Case bTypSpravy 'vyhodnocení - správa o chybách
'Case 0: MsgBox "Vytvoření PDF - OK" & vbNewLine & IIf(ODESLAT_MAIL, "Odeslání", "Vytvoření") & " mailu - OK", vbInformation
Case 0: MsgBox "Vytvoření PDF - OK", vbInformation
If Not ODESLAT_MAIL And Not OutMail Is Nothing Then OutMail.Display 'zobrazení vytvořeného emailu
Case 1: MsgBox "Tento adresář nebylo možné vytvořit !" & vbNewLine & vbNewLine & sDir, vbCritical
Case 2: MsgBox "Nastala chyba při vytváření souboru !" & vbNewLine & vbNewLine & sSoubor, vbCritical
Case 3: MsgBox "Není možné otevřít Outlook !" & vbNewLine & vbNewLine & sSoubor, vbCritical
'Case 4: MsgBox "Vytvoření PDF - OK" & vbNewLine & "Odeslání mailu - účet neexistuje ( " & ODESILATEL_MAIL & " )", vbExclamation
Case 5: MsgBox "Vytvoření PDF - OK" & vbNewLine & "Odeslání mailu - chyba !", vbExclamation
If Not ODESLAT_MAIL And Not OutMail Is Nothing Then OutMail.Display 'zobrazení vytvořeného emailu
End Select

'v případě, že Outlook byl otvíraný makrem, mail hned odesílaný (ODESLAT_MAIL=True), a je třeba ho zavřít (ZAVRIT_OUTLOOK=True) - tak se zavře
'If bOteviranyOutlook And ZAVRIT_OUTLOOK And ODESLAT_MAIL Then OutApp.Quit

'zrušení objektů
Set OutApp = Nothing: Set OutMail = Nothing ': Set oUcet = Nothing
End Sub

Function Vytvor_Adresarovou_Strukturu(ByVal sDir As String) As Boolean 'Vytvoření adresářové struktury, včetně podadresářů
Dim F() As String, i As Integer

F = Split(sDir, "\") 'rozdělí cestu na podadresáře
sDir = ""

With CreateObject("Scripting.FileSystemObject")
On Error Resume Next
For i = 0 To UBound(F) - 1 'postupně kontroluje a vytváří podadresáře (poslední lomítko vynechá - ošetřeno na začátku)
sDir = sDir & IIf(Len(sDir) = 0, "", "\") & F(i)
If Not .FolderExists(sDir) Then .CreateFolder sDir
Next i
End With

Vytvor_Adresarovou_Strukturu = Err.Number = 0 'False - když nastala chyba
End Function

'Sub Vypis_Uctov_Outlooku() 'pouze kontrolní makro pro výpis seznamu účtů v Outlooku a jejich adres
'Dim OutApp As Object, oUcet As Object
'
' On Error Resume Next
' Set OutApp = GetObject(, "Outlook.application") 'ověření, zda není Outlook otevřený
'
' If OutApp Is Nothing Then
' Set OutApp = CreateObject("Outlook.Application") 'otevření Outlooku, pokud není otevřen
' If OutApp Is Nothing Then Debug.Print "CHYBA" 'chybová správa o otvírání Outlooku
' End If
' On Error GoTo 0
'
' For Each oUcet In OutApp.Session.Accounts 'výpis účtů
' Debug.Print oUcet & "......." & oUcet.CurrentUser.Address
' Next oUcet
'
' Set OutApp = Nothing: Set oUcet = Nothing
'End Sub

posláno

Super, děkuji.
Radek
a kam mám poslat příspěvek?

Jj, jsou tam i kratší, já tam dal vše, pak to budu mít vyčištěné před prvním nasazením.
Ale stále, když zadám například 7 pouze písmen, tak se to uloží.
Já to nenapsal původně. Mělo by tam být číslo, někde, u ele aut bude třeba až od třetí pozice, ale bude tam vždy alespoň jedno číslo.. A písmeno musí být na druhé pozici.
Díky.
Radek
kam vám mohu přispět?

Jj, už jsem použil váš soubor s tím přejmenováním.
Když zadám například 1234567, tak se RZ uloží.
Ale v RZ musí být minimálně jedno písmeno a to na druhé pozici.
U elektroauta jsou první dva znaky "EL".
Celkový počet znaků RZ je 7, ty na přání mají 8.
Šlo by to nějak zakomponovat do těch podmínek?
Děkuji.
Radek

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse