Příspěvky uživatele

Chýbajú tam apostrofy
CESTA = "'[" & ThisWorkbook.Name & "]" & "List1'!D5"
ale hlavne to postráda zmysel, načítať hodnotu otvoreného súboru cez EVALUATE. Veď poznáte meno zošitu aj listu aj adresu bunky, tak si dajte
Workbooks("TEST5.xlsm").Worksheets("List1").Range("D5").Value
a
ThisWorkbook.Worksheets("List1").Range("D5").Value

OT: @ marjankaj :

Ale prd, len som lenivý, nechce sa mi, som taký nejaký poklesnutý a demotivovaný z tej celej situácie okolo covitu ... nikoho neumravňujem

Dajte nejakú prílohu, nech si to nemusíme vytvárať zase sami. Aspoň pár kategórií a dát. Dáta nemusia byť tie Vaše, kľudne vymyslené, ale rovnakého formátu, typu a rozmiestnenia.

Návod ako to sprevádzkovať.

marjankaj má pravdu, v týchto 2 prípadoch tam treba ešte pridať kontrolu na samotný deň. V druhom prípade sa naopak vypúšťa kontrola času.

Nie som teraz pri PC, ale myslím, že bude stačiť tie dve časové podmienky obaliť do NOT().

Pr.

Pomocné stĺpce asi ani nepotrebujete.

Súbor otvárať nemusíte. Môžete použiť buď metódu ExecuteExcel4Macro, alebo vzorec do nepoužívanej bunky.
Sub Porovnaj()
Dim Hodnota
With ThisWorkbook.ActiveSheet
With .Range("H4")
.Formula = "='" & ThisWorkbook.Path & "\[TEST2.xlsm]List1'!$D$5"
Hodnota = .Value
.ClearContents
End With

If Hodnota = .Range("D5").Value Then
MsgBox "Bunky se rovnají"
Else
MsgBox "Bunky se NErovnají", vbCritical
End If
End With
End Sub
Sub Porovnaj2()
Dim Hodnota
With ThisWorkbook
Hodnota = Application.ExecuteExcel4Macro("'" & .Path & "\[TEST2.xlsm]List1'!R5C4")
If Hodnota = .ActiveSheet.Range("D5").Value Then
MsgBox "Bunky se rovnají"
Else
MsgBox "Bunky se NErovnají", vbCritical
End If
End With
End Sub
Na pár buniek ExecuteExcel4Macro rýchlostne v pohode. Na tisíce použite z týchto dvoch metód radšej tie vzorce.

Public Sub PridajHyperlink()
'Pridať referenciu na Microsoft Word 16.0 Object Library
Dim objItem As Object
Dim objInsp As Outlook.Inspector
Dim objWord As Word.Application
Dim objDoc As Word.Document
Dim objSel As Word.Selection

On Error Resume Next
Set objItem = Application.ActiveInspector.CurrentItem

If Not objItem Is Nothing Then
If objItem.Class = olMail Then
Set objInsp = objItem.GetInspector
If objInsp.EditorType = olEditorWord Then
Set objDoc = objInsp.WordEditor
Set objWord = objDoc.Application
Set objSel = objWord.Selection

With objSel
If Len(.Text) > 1 Then .Hyperlinks.Add .Range, .Text
End With
End If
End If
End If

Set objItem = Nothing
Set objWord = Nothing
Set objSel = Nothing
Set objDoc = Nothing
Set objInsp = Nothing
End Sub
Pridať Modul, pridať referenciu, kód do modulu. Pridať na karte Vložiť novú skupinu, pridať do nej makro. Vo VBA editore Uložiť.
V Centre zabezpečenia v nastaveniach treba povoliť všetky makrá.

Tak?

Skúste toto. Upravil som podmienený formát (to si nastavte), zjednotil Browse tlačítka, upravil makro, ale teraz Vám zase na vzorovom súbore nesedia tie adresy buniek, na ktoré má hyperlink odkazovať. V tabuľke máte iné názvy listov ako "Souhrn", ktorý tvrdíte, že tam bude, a z ktorého sa majú ťahať data. Nerozumiem Vám presne...

Úprava:
Sub FILTR4()
Dim i As Long
Dim ARE As Range
Dim Vzorec As String

Application.ScreenUpdating = False

'CZ
'Vzorec = "=SVYHLEDAT(List1!D•;List2!$B:$C;2;0)"

'SK
Vzorec = "=VLOOKUP(List1!D•;List2!$B:$C;2;0)"

With List1
'Projde všechny vyfiltrované spojité podoblasti - Areas
For Each ARE In .Range("E7:E" & .Cells(Rows.Count, 4).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Areas
With ARE
.FormulaLocal = Replace(Vzorec, "•", .Row) 'Vloží do nich upravený vzorec, kde se mění "•" za 1. řádek podoblasti
.Value = .Value 'Převod vzorce na hodnotu
End With
Next ARE
End With

Application.ScreenUpdating = True
Set ARE = Nothing
End Sub

Čo znamená že je prázdny? Že tam nieje vôbec žiadna Tabuľka? Veď tú nemažte aj s hlavičkami. Samotný Objekt Tabuľka s hlavičkami a prvým aj keď prázdnym riadkom sa necháva. Vy chcete aby sa kontrolovalo, či existuje Tabuľka "tblKopieM", ak nie tak ju vytvoriť a naformátovať (farba, tučné, vystredenie, formát, dátum, veľkosť, výška, ...), ale to samozrejem iba v prípade, že existuje list "Kopie makro". Ak ani ten nieje, tak ho vytvoriť, a následne v ňom tú Tabuľku....
A nieje jednoduchšie, aby tam ten list aj s tou Tabuľkou stále bol?

Oprava, musí sa to urobiť po oblastiach:
Sub FILTR4()
Dim i As Long
Dim ARE As Range
Dim Vzorec As String

Application.ScreenUpdating = False

Vzorec = "=D•+$E$5"
With List1
For Each ARE In .Range("E7", .Cells(Rows.Count, 5).End(xlUp)).SpecialCells(xlCellTypeVisible).Areas
With ARE
.FormulaLocal = Replace(Vzorec, "•", .Row)
.Value = .Value
End With
Next ARE
End With

Application.ScreenUpdating = True
Set ARE = Nothing
End Sub

Příspěvky uživatele

Uživatelské menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje