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

Příspěvky uživatele

No, keď netušíme čo a ako to makro robí ...
Skúste najskôr "vypočítať" bunky/riadky/stĺpce s rovnakým formátom pomocou Union, a nastavte ich potom naraz, nie po jednom (bunke, riadku, stĺpci). Všetky rovnaké naraz, lebo budú pomocou Union združené v jednom Range.

Odkazujete tam na bunku L4, tá dáva vždy "", musíte odkazovať na I4. To je len detail.

Výborné riešenie cez AutoFilter, chcel som to ísť urobiť cez filtrovanie poľa. Toto je lepšie.

Ak bude dotyčný chcieť vymazať len riadky ktoré odpovedajú aj tovaru, aj firme, aj dátumu, aj množstvu tak to musí byť nejako takto. Inak sa mu vymažú aj riadky pre iné firmy, ale možno o to ide. Na to aby to filtrovalo aj dátum, som ale musel pridať schovaný stĺpec s číslom dňa, lebo filter mi dátum ako dátum nefiltruje tak ako si predstavujem. Akviete niekto tento filter dátumu vyriešiť inak, prosím písnite.

Kód na pridanie riadkov som skrátil. Bez With by to šlo dať na jeden riadok.

Vždy sa dá urobiť PrintScreen + OCR, môže byť aj neviem ako zamknutý. OCR Vám z toho ten text väčšinou urobí. Dokonalá ochrana proti kopírovaniu textu neexistuje.

@dod175 : nech sa páči.

@eLCHa : dnes som uz nemal čas, ale Hyperlink mi robí doslova psie kusy.
-použitie validných adries je samozrejmé
-Vzorec mi robí to čo som popisoval, ruka je, nefunguje, farbu ani podčiarknutie nemá.
-ak hneđ vedľa manuálne vytvorím HL z rovnakou adresou, ten funguje normálne, a nemusím použiť ani http, čo pred tým nešlo.
-Opakoval som to niekoľkokrát a zistil, že niekedy nepravideľne, po manuálnom vložený HL, začali fungovať aj tie počítané, neboli sice podčiarknuté ani farebné ale niekedy fungovali.
Prepínanie na automatický výpočet listu a na manuálny som skúšal, nič nepomáhaéúé

Ešte posledná vec a utekám:
"http://" by som nedával priamo ale s podmienkou, či už náhodou odkaz "http://" neobsahuje.
Takže namiesto "http://" :
IF(LEFT('Z:\Prepojené zošity\[data.xlsx]Hárok1'!D2;4)="http";'Z:\Prepojené zošity\[data.xlsx]Hárok1'!D2;"http://"&'Z:\Prepojené zošity\[data.xlsx]Hárok1'!D2)
PS: Som zabudol, mne to odkaz nevytvorí funkčný ani s "http://". Prečo netuším.

No takto by to bolo super, keby sa pýtajúci vyjadril k predikcii počtu riadkov.
Vám ten
=IF(A2="";"";HYPERLINK('Z:\Prepojené zošity\[data.xlsx]Hárok1'!D2;'Z:\Prepojené zošity\[data.xlsx]Hárok1'!D2))
vráti funkčný odkaz na www stránku ? Mne vráti iba "kváziodkaz". Čiže má síce kurzor "Ruka", akože sa naň dá kliknúť, ale nič sa neudeje, ani nieje podčiarknutý ani modrý, ako normálny HL. Neviem prečo. Niečo musí byť zle u mňa.

EDIT: Som si nevšimol Váš post. O počet riadkov vzorcom nejde, na to stačí úplne CountA, ktorý som spomínal niekde na začiatku. Ale ide o to, že treba myslieť dopredu na možný počet riadkov, a nakopírovať potrebné množstvo vzorcov. Nevieme do akej miery je to možné, keďže k tomuto sa dotyčný stále nevyjadril. Makrom by sa dalo nakopírovať len toľko vzorcov koľko je treba, ale zase makrom nejde len tak ľahko zistiť počet riadkov v zatvorenom zošite, bez pomocného vzorca v bunke. Ako som písal. Napr. Evaluate, na zatvorený zošit nefunguje. Excel4Makro tiež netuším ako použiť na zistenie počtu riadkov.
Ale Vaše smerovanie pomôže možno aj v tomto smere, keď by sa dalo v Excel4Macro volať Definovaný názov, ktorý by to počítal... nemám už viac teraz čas ...

Toto by malo odolať chybe, a nič po sebe nezanecháva. V predošlom kóde upravenom v noci z hlavy v tablete, bola chyba.
Sub Aktualizuj()
Dim EXA As Excel.Application, WB As Workbook
Set EXA = CreateObject("Excel.Application")
Set WB = EXA.Workbooks.Open(Application.ThisWorkbook.Path & "\data.xlsx")
On Error GoTo CHYBA
With WB.Worksheets("Hárok1").Range("A:D")
.Resize(.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row).Copy
Windows("prepojenie.xlsm").Activate
With ThisWorkbook.Worksheets("Hárok1").Range("A:D")
.Clear
.Cells(1, 1).Activate
Application.CutCopyMode = False
ActiveSheet.Paste
.Cells(1, 1).Select
End With
End With
CHYBA:
If Err <> 0 Then vbMsg = MsgBox("Chyba pri aktualizácii dát.", vbCritical, "Aktualizácia")
If Not WB Is Nothing Then WB.Close False
Set WB = Nothing
Set EXA = Nothing
End Sub

Pretože ma nenapadá ako inak zistiť počet riadkov v zatvorenom zošite, a potom tieto riadky skopírovať aj s Hyperlinkom (HL). Na môj návrh spočítať riadky vzorcom v pomocnej bunke (v schovanom stĺpci, liste ...), alebo použitie Excel4Macro, nikto nereflektoval.
Vzorec HL nezkopíruje, ale na opätovné vytvorenie HL som sem makro dal. Testovať to nejdem, ale možno vytvorenie inštancie Excelu + Copy Paste, bude trvať kratšie ako nakopírovanie potrebného počtu vzorcov, prebehnutie 1000 buniek kvôli vytvoreniu HL.
Ale možno ide kopčiť HL so zatvoreného zošitu, aj inak. Zatiaľ ďalej neskúmam.

U mna sa nič také neprejavovalo, ale skúsim si z tabletu tipnúť:
1. Nezabudli ste na zrušenie inštancie Excelu v pamäti ? Keđže táto inštancia je vlastníkom toho zošitu, mal by byť zrušený spolu s nou.
Set EXA = Nothing
2. Ak nepomôže, tak skúste
Sub Aktualizuj()
Dim EXA As Excel.Application, WB as Workbook
Set EXA = CreateObject("Excel.Application")
Set WB = EXA.Workbooks.Open(Application.ThisWorkbook.Path & "\data.xlsx").Worksheets("Hárok1")
With WB
.Range("A:D").Resize(.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row).Copy
Windows("prepojenie.xlsm").Activate
With ThisWorkbook.Worksheets("Hárok1").Range("A:D")
.Clear
.Cells(1, 1).Activate
Application.CutCopyMode = False
ActiveSheet.Paste
.Cells(1, 1).Select
End With
End With
Set WB = Nothing
Set EXA = Nothing
End Sub
3. Prípadne vyskúšať ako posledný príkaz v konštrukcii
With WB...
doplniť
.Close
4. Skontrolujte si v Správcovy procesov (Ctrl+Shift+ESC), či Vám nebežia đalšie inštancie Excelu z predošlých pokusov. Ak áno, tak pklik a Ukončiť proces.

Ešte by sa to dalo celé riešiť napr aj takto :
Sub AktualizujHyp()
Dim Bunka As Range, H As String, R As Long
Dim EXA As Excel.Application, WB As Workbook, WS As Worksheet
Set EXA = CreateObject("Excel.Application")
Set WB = EXA.Workbooks.Open(Application.ThisWorkbook.Path & "\data.xlsx")
Set WS = WB.Worksheets("Hárok1")
R = WS.Range("A:D").Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
With ThisWorkbook.Worksheets("Hárok1")
With .Range("A:D")
.ClearContents
.Resize(R) = WS.Range("A:D").Resize(R).Value
End With
WB.Close False
Set EXA = Nothing
If R = 1 Then Exit Sub
For Each Bunka In .Cells(2, 4).Resize(R - 1)
If Not IsEmpty(Bunka) Then
With Bunka
H = .Value
H = IIf(Left(H, 4) = "http", "", "http://") & H
With .Hyperlinks
If .Count = 0 Then .Add anchor:=Bunka, Address:=H Else Bunka.Hyperlinks(1).Address = H
End With
End With
End If
Next Bunka
End With
End Sub
Predošlé makro doplnené a zaujímavý spôsob prístupu do zatvoreného súboru od Paloo, čerpané odtiaľto:
http://wall.cz/index.php?m=topic&id=24364#post-24377
Treba to ale ešte zabezpečiť na odchyt chýb, pretože to vytvára samostatnú aplikáciu Excel (skrytú), a akonáhle príde k nejakej chybe, tak tento druhý Excel ostane visieť s alokovanými zdrojmi, teda aj zamknutým data.xlsx pre zápis.
V tomto prípade by možno šlo použiť aj Copy Paste, a nemusia sa potom upravovať linky v prípade, že sú to http linky, a nie len www. Mne totiž www neotvorí, iba http. Takže ak to nieje len nesprávnym nastavením môjho Excelu, a chcete mať zobrazené názvy linkov tak ako ich máte, potom treba urobiť aj tú spodnú časť kódu.

EDIT:
Tak toto je metóda, ako skopírovať celú použitú oblasť z data.xlsx aj s formátovaním a hyperlinkami proste tak ako to je v data.xlsx. Ale ako som spomínal, treba zvážiť počet plánovaných riadkov, či nebude lepšie použiť Excel4Makro a počet riadkov mu určí schovaný vzorec s COUNTA, alebo presypať cez Value, alebo vložiť vzorec, a upraviť Hyperlinky bunku po bunke.
Sub Aktualizuj()
Dim EXA As Excel.Application
Set EXA = CreateObject("Excel.Application")
With EXA.Workbooks.Open(Application.ThisWorkbook.Path & "\data.xlsx").Worksheets("Hárok1").Range("A:D")
.Resize(.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row).Copy
Windows("prepojenie.xlsm").Activate
With ThisWorkbook.Worksheets("Hárok1").Range("A:D")
.Clear
.Cells(1, 1).Activate
Application.CutCopyMode = False
ActiveSheet.Paste
.Cells(1, 1).Select
End With
End With
Set EXA = Nothing
End Sub

Pre nastavenie Hyperlinkov možno použiť makro :
Sub AktualizujHyp()
Dim Bunka As Range, H As String, R As Long
With ThisWorkbook.Worksheets("Hárok1")
R = .Range("A:D").Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row - 1
If R = 0 Then Exit Sub
For Each Bunka In .Cells(2, 4).Resize(R)
If Not IsEmpty(Bunka) Then
With Bunka
H = .Value
H = IIf(Left(H, 4) = "http", "", "http://") & H
With .Hyperlinks
If .Count = 0 Then .Add anchor:=Bunka, Address:=H Else Bunka.Hyperlinks(1).Address = H
End With
End With
End If
Next Bunka
End With
End Sub
Nechať ho spustiť napr po otvorení súboru.
Treba ale predikovať, koľko riadkov má byť zaplnených vzorcami, keďže netuším, aká by sa dala aplikovať funkcia na zistenie počtu zaplnených riadkov v zatvorenom zošite, okrem :
1. vzorec v pomocnom liste alebo bunke
=COUNTA('Z:\Prepojené zošity\[data.xlsx]Hárok1'!A:A)
2. cyklické prechádzanie buniek v A:A cez ExecuteExcel4Macro, to je ale pomalé.

Ak tento vzorec vložíte do bunky A2, a rozkopírujete ho na všetky potrebné stĺpce a riadky, bude kopírovať údaje zo zatvoreného Data.
=IF([data.xlsx]Hárok1!A2="";"";[data.xlsx]Hárok1!A2)
Ale nie hyperlinky. To by sa muselo pravdepodobne makrom, pri otvorení zošita, alebo pri nej príležitosti (časovač, aktivácia, klik...).

No už to sem dám, čo s tým:
1. Hárok2 - Tam je na to vzorec, odtiaľ si skopírujte len celý stĺpec A a niekam vložte, Poznámkový blok atď.
2. makro ExportTXT to robí celé makrom, vytvorí/prepíše súbor Zasobnik2.TXT
3. makro ExportTXT2, použije ako zdroj vzorce z Hárok2, vytvorí/prepíše súbor Zasobnik3.TXT

1. - treba ešte ukladať v niečom data
2. - pomalé
3. - toto je najlepšia a najrýchlejšia možnosť

Priložené sú aj vzorce v TXT (aj rozložené, aj zložené), dali by sa urobiť aj inak, napr. maticovo s potrebnou šírkou v maticovej konštante, ale bola by tam veľká komplikácia so znamienkami "+" iba u niektorých stĺpcov, "%" atď.

Mám to pre Vás už vyriešené vzorcom. Ešte dopilovávam aj makro verziu. Nezabudli sme na Vás, nebojte
Dám Vám to sem naraz.

With ThisWorkbook 'Pro tento sešit
With .Worksheets("Datový list")
N = .Range("A26") & " " & .Range("C26") 'Název pro nový list
End With
Cesta = .Path & "\"
With .Worksheets("Protokol")
.Buttons("btnOdeslatUlozit").Visible = False 'Skryť tlačítko
On Error Resume Next
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Cesta & N, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
If Err <> 0 Then
MsgBox ("Chyba při exportu do" & vbNewLine & Cesta & N)
Err.Clear
End If
On Error GoTo 0
.Buttons("btnOdeslatUlozit").Visible = True 'Zobraziť tlačítko
End With
End With

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse