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

Příspěvky uživatele

Bublinka, trúfam si tvrdiť, že o exceli viem viac, než Ty a mne osobne prvé (vzorec) i druhé (rozšírený filter) riešenie príde naprosto dostatočné. Je to práca na cca jednu minútu, v oboch prípadoch. Tebe to ale nestačí. Čakáš, že budem vymýšľať kód alebo vzorec, písanie ktorého mi zaberie nejaký čas a i tak ho nebudeš chápať. Prečo to chceš inak, než som uviedol? Čo ti na tých riešeniach vadí? Ten rozšírený filter ti to dokonca radí pod seba, tak v čom je problém?

ako som zmienil, napísať na to kód nie je v mojom prípade práca na 5 minút a čas budem mať najskôr až vo štvrtok (a to je otázka, či vôbec). Dá sa manuálne. Vyexportuj moduly a naimportuj ich do pôvodných súborov...

edit:
medzitým sa môžeš inšpirovať tuná:http://social.msdn.microsoft.com/Forums/en-US/a60ab0e0-f8ce-430f-8d4f-9ca655bcd0cb/vba-create-and-add-a-macro-for-excel-programmatically
Keď som to onehdá riešil, tak som si k tomu vytvoril vzor (podotýkam, že to nie je funkčné riešenie, ale možno z toho niečo vyčítaš, na viac čas teraz bohužiaľ nemám):Sub xx()

Dim myWrkb As Workbook
Dim strMacro As String
Dim prrf_Module As VBComponent

Set myWrkb = Workbooks.Add
' Set myWrkb = ActiveWorkbook


Set prrf_Module = myWrkb.VBProject.VBComponents(myWrkb.Worksheets(1).Name) ' ..VBComponents.Add(1) - prida kod do listu
' Set prrf_Module = myWrkb.VBProject.VBComponents(1) ' ..VBComponents.Add(1) - prida kod do thisworkbook

strMacro = "Private Sub prrf_Workbook_setPage()" & vbCr
strMacro = strMacro & "end sub"
prrf_Module.CodeModule.AddFromString strMacro
' Set prrf_Module = myWrkb.VBProject.VBComponents.Add(1) 'prida modul
'myWrkb.VBProject.VBComponents.Remove myWrkb.VBProject.VBComponents.item("Module1") 'odstrani modul
' prrf_Module.CodeModule.DeleteLines 1, prrf_Module.CodeModule.CountOfLines 'premaze cely modul

End SubAby to fungovalo, musíš nastaviť refernciu na knižnicu Microsoft Visual Basic for Applications Extensibility 5.3
V zásade: Potrebuješ načítať modul z aktuálnej verzie, to ide napr. do texťáku. Z texťáku to potom načítaš do premennej strMacro a pomocou metódy AddFromString z premennej strMacro dostaneš do pôvodného modulu, z ktorého pomocou metódy DeleteLines predtým odstrániš pôvodný kód. Je mi jasné, že popis je chaotický, ale viac v túto chvíľu fakt nepomôžem, nemám na to čas

tj. moze pracovat aj Offline
No, úplne offline asi nie, ale i tak by ma to zaujímalo. Nemohol by si mi sem, alebo do nového vlákna, aby sme to tu nezaplnili off-topicmi, dať príklad toho kódu?

@Paloo:
mal by vsetkych uzivatrelou orientovat do jedneho adresara s makrami a odtial by ich nacitavali Všetko má svoje výhody i nevýhody. Pokiaľ sú makrá niekde na serveri, tak potrebuješ mať na server prístup. Nespustíš makro, pokiaľ si napr. doma (ako napr. dnes ja) a na server sa nepripojíš napr. cez VPN. Osobne makrá na server neukladám, distrujem doplnok a každý si ho u seba musí nainštalovať. Pri jeho aktualizácii znovu. Je to trochu prúda, ale zas to behá i bez prístupu na server.

@Paloo
Mám za to, že OP chce dostať aktualizované Moduly do tých pôvodných súborov. To samozrejme ide, dokonca viacerými spôsobmi. Asi najprimitívnejším je export a import modulu. Iný spôsob je celé to zariadiť programovo. Ale to nenapíšem za 5 minút, takže iba skonštatujem: Ide to.

@mikkinachtik
Ty píšeš kódy a distribuješ ich po firme? Bez urážky, to by som nečakal...

píše mi to #NÁZEV?
nevíš, čím by to mohlo být? Som písal na začiatku:V českom exceli miesto IF napíš KDYŽ
To asi nepůjde, aby mi to vypsalo všechno pod sebe, co Ide všetko, hlavne sa musí vedieť, čo sa chce. Hore si nepísala, že to nemá vypísať na ten samý riadok, teraz začínaš vymýšľať. V prílohe máš riešenie cez rozšírený filter. Do stĺpca D to vypisuje pod seba. Obrázok, ako nastaviť ten filter, máš priamo v súbore.

možná sem zapoměl něco přepsat podle lokalizace?
Ne. Zmenil si názov makra, tak ho musíš zmeniť i v tej druhej rutine (Private Sub Workbook_Open())

Do bunky D1 napíš vzorec:=IF(COUNTIF(B:B; A1); ""; A1) a skopíruj dolu. V českom exceli miesto IF napíš KDYŽ

Písal si, že súbory majú príponu txt, nie TXT :) Stačí príslušný riadok prepísať na:If LCase(Meno) Like "*.txt" Then Nešlo by to nějak nastavit, aby se to aktualizovalo hned po otevření dokumentu? Do kódového okna ThisWorkbook vlož:Private Sub Workbook_Open()
Call test
End Sub Inak, k sub rutinám, ktoré nie sú Private, máš prístup priamo z excelu prostredníctvom Alt+F8. Za mystifikáciu so Sheet/List sa ospravedlňujem, mám anglický excel, kódový názov listu je potom Sheetxxx, v českej lokalizácii Listxxx, toto Microsoft pmn nedomyslel a makro tak bez úprav nie je prenositeľné medzi rôznymi lokalizáciami.

Runtime error 9 - Subscript out of range
mi hodí, keď zadám cestu:
Cesta = "C:\feed\"
si si istý, že daný adresár skutočne existuje? Ja taký adresár vytvorený u seba nemám, keď ho vložím do kódu, dá mi tiež uvedenú chybu.

Změnil Sheet1 na List1. Prečo? Kódové okno listu je Sheet1, nie List1... Tak toto nemeň. Skontroluj si, či máš v C:\feed\ nejaké .txt súbory k importu, o.k.? V opačnom prípade vlož do cesty adresár, v ktorom sa tie *.txt skutočne nachádzajú.

edit:
Tá chyba v tomto prípade hovorí, že myArray sa nevytvoril. To je spôsobené buď tým, že je špatne zapísaná cesta v premennej cesta (adresár, v ktorom majú byť *.txt, súbory), t.j. buď daný adresár neexistuje, alebo sa v ňom žiadne .txt nenachádzajú.

Pokiaľ budú tie texťáky v jednom adresári, tak napr. takto (makro vygeneruje vždy celý zoznam odznova - do stĺpca A prvého listu naimportuje postupne všetky riadky jednotlivých *.txt súborov z daného adresára):Sub test()
Dim Riadok As String, Cesta As String, Atr As String, Meno As String, myArray() As Variant, i As Long

Cesta = "C:\Documents and Settings\Desktop\" 'sem zadaj adresar, z ktoreho chces nacitat
Atr = vbNormal
Meno = Dir(Cesta, Atr)

Do While Meno <> ""
If Meno Like "*.txt" Then
Open Cesta & Meno For Input As #1
Do While Not EOF(1)
Line Input #1, Riadok
ReDim Preserve myArray(i)
myArray(i) = Riadok
i = i + 1
Loop
Close #1
End If
Meno = Dir
Loop

' vystup na prvy list do stlpca A
Sheet1.[A:A].ClearContents
Sheet1.[A1].Resize(UBound(myArray, 1) + 1, 1) = WorksheetFunction.Transpose(myArray)

End Sub

Prípadne do okna ThisWorkbook vlož ešte:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Sh.Name = "ZAZNAM" Then Call Generuj
End SubPo kliknutí do (aktivovaní) listu ZAZNAM sa makro spustí automaticky a nemusíš klikať na žiadne tlačítko.

Nasledujúci kód si daj pod tlačítko. Budeš musieť spúšťať pri zmene na liste Leden (po tom, čo vyplníš list, alebo ho nejako zmeníš), kód vytvorí zoznam na liste ZAZNAM vždy celý odznovu (farbičky som neriešil):Option Explicit

Sub Generuj()
Dim myRng As Range, myArray() As Variant, i As Integer, datum As Date

Set myRng = Sheets("ZAZNAM").[A9].CurrentRegion

With myRng
If .Rows.Count > 1 Then
Set myRng = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count)
myRng.ClearContents
End If
End With

With Sheets("LEDEN")
Set myRng = .[A2]
Do While myRng <> ""
With myRng
If .Offset(0, 4) = "U" Then
ReDim Preserve myArray(3, i)
myArray(0, i) = .Value
myArray(1, i) = .Offset(0, 4)
myArray(2, i) = Format(.Offset(0, 1), "h:mm")
myArray(3, i) = Format(.Offset(0, 2), "h:mm")
i = i + 1
End If

If .Offset(0, 3) = "C" Then
If .Offset(-1, 3) <> "C" Then
ReDim Preserve myArray(3, i)
myArray(0, i) = .Value
datum = .Value
myArray(1, i) = .Offset(0, 3)
myArray(2, i) = Format(.Offset(0, 1), "h:mm")
myArray(3, i) = Format(.Offset(0, 2), "h:mm")
i = i + 1
Else:
myArray(0, i - 1) = datum & "-" & myRng
myArray(3, i - 1) = Format(.Offset(0, 2), "h:mm")
End If
End If
Set myRng = .Offset(1, 0)
End With
Loop
End With

Sheets("ZAZNAM").[A10].Resize(UBound(myArray, 2) + 1, UBound(myArray, 1) + 1) = WorksheetFunction.Transpose(myArray)
Set myRng = Nothing
Erase myArray
End Sub

Ja myslím, že Pavlus rozumie a odpovedal pmn tiež zrozumiteľne. Tak ešte raz:With UserForm1.TextBox1
If IsEmpty(Range("A" & ActiveCell.Row)) Then
.Locked = False
Else:
.Text = Range("A" & ActiveCell.Row).Value
.Locked = True
End If
End With

Trochu univerzálnejšie (v prvom príklade by si totiž vždy musel dopredu určiť umiestnenie *.exe súboru príslušného prehliadača, ktoré sa logicky na rôznych počítačoch môže líšiť).
Nebude sa jednať o hyperlink, ale o bunku(bunky), v ktorých budú webové adresy (môžeš naformátovať tak, aby na prvý pohľad vyzerali ako hyperlink, že to hyperlink fakticky nebude, snáď nevadí).
Príklad pre bunku B25 v ktorej bude napísané (presne, ako vidíš, t.j. bez úvodzoviek) napr.:
wall.cz
(v prípade ďalších buniek si jednoduchým spôsobom dotvoríš časť kódu uloženú v kódovom okne listu:Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$B$25" Then Call test(Target.Value)
End Sub.
Do modulu vložíš:Option Explicit

Private Declare Function SearchTreeForFile _
Lib "imagehlp" (ByVal RootPath As String, _
ByVal InputPathName As String, _
ByVal OutputPathBuffer As String) As Long

Const Adresare = 100

Sub test(Site As String)
Dim strS As String
Dim lngL As Long
Dim Prehliadac As String
Prehliadac = "chrome.exe"
strS = String(Adresare, 0)
lngL = SearchTreeForFile("C:\", Prehliadac, strS)
If lngL <> 0 Then
Shell strS & "exe " & Site, vbNormalFocus
Else
MsgBox "Prehliadaè nebol nájdený!", _
vbCritical
Exit Sub
End If
End Sub
Pripravené pre otvorenie v Google chrome, v prípade iného prehliadača dáš do kódu miesto google.exe príslušný *.exe daného prehliadača. Po kliknutí do príslušnej bunky (v uvedenom príklade bunky B25) by sa malo stať to, čo potrebuješ.

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse