Příspěvky uživatele
< návrat zpět
Ahoj, tady makro viz níže, které maže komplet všechny makra co je v sešite.
Vložit do Thisworkbook
Private Sub Workbook_Open()
Dim VBProj As Object
Dim VBComp As Object
Dim Modul As Object
Dim DatumSmazani As Date
' Nastav požadované datum smazání
DatumSmazani = DateValue("2025-02-13") ' Změň na požadované datum
' Pokud je dnešní datum vyšší nebo rovno zadanému datu, smaže kód
If Date >= DatumSmazani Then
' Povolit přístup k VBA projektu
Set VBProj = Thisworkbook.VBProject
' Projít všechny moduly a smazat je
For Each VBComp In VBProj.VBComponents
Select Case VBComp.Type
Case 1, 2, 3 ' Standardní moduly, třídy a uživatelské formuláře
VBProj.VBComponents.Remove VBComp
Case 100 ' Modul sešitových událostí (např. ThisWorkbook, List1,...)
Set Modul = VBComp.CodeModule
Modul.DeleteLines 1, Modul.CountOfLines
End Select
Next VBComp
MsgBox "Uplinula doba trial verze, všekeré makra byly odstraněny!"
End If
End Sub
A co ten datum?
Bude vázaný na buňku, fixně nastavený v makru, z userformu, nebo jakým způsobem se dopracuje k tomu datumu?
Písmo ve sloupcích "E:G" (jak píše elnino) byla bíla barva.
A já se divil proč mi vzorec nic nevrací 
Koukám, že já zadaní špatně pochopil ohledně vzorců "F:G", elninoslov to má správně. Tak to prosím ignorujte.
A sloupec "E" se bude muset dořešit, jak píše kolega, pokud práce budou na etapy a bude mezera v pracovních dnech.
A omlouvám se, že do této konverzace skáču, už se dále nebudu vměšovat 
Ahoj,
tak koukám, že mě elninoslov předběhl , ale už to sem přidám když jsem se stím hrál 
jj ta bílá barva mi taky zamotala hlavu 
Ahoj,
provedl jsem úpravy, přidal jsem podmínku aby bral v potaz řádky jenom 2 až 150 zbytek přeskočí.
Taky jsem upravil duplicitu. není to zrovna elegantní řešení, ale snad funkční. Pokud by to někdo chtěl upravit nebudu se zlobit 
ahoj,
tak snad jsem pochopil zadaní, původní makro jsem zakomentoval a dal tam svůj, plus jsem přidal seřazení dat pro ostatní listy. Dělá to jenom do řádku 150 jak bylo i v zadání.
Radši si to pořádně zkontroluj jestli to dělá co má, než použiješ naostro.
ahoj,
do určeného listu (List1) vlož:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(False, False) = "A3" Then Call tvojeMakro
End Sub
místo "tvojeMakro" vlož svoje makro
Dobrý den,
tady bych raději použil makro.
Option Explicit
Sub RozdelAdresy()
Dim ws As Worksheet
Dim posRdk As Long
Dim i As Long
Dim ulice As String
Dim popisne As String
Dim regEx As Object
Dim matches As Object
' Nastavení listu, kde jsou data
Set ws = ThisWorkbook.Sheets(1) ' Změň číslo listu, pokud je potřeba
With ws
' Najde poslední řádek ve sloupci D
posRdk = .Cells(.Rows.Count, "D").End(xlUp).Row
' Vytvoření RegEx objektu
Set regEx = CreateObject("VBScript.RegExp")
regEx.Global = True
regEx.Pattern = "^(.*?)(\d.*)$"
' Prochází všechny řádky ve sloupci D
For i = 2 To posRdk ' Předpokládáme, že hlavička je na řádku 1
If .Cells(i, "D").Value <> "" Then
' Zpracuje adresu pomocí RegEx
If regEx.Test(.Cells(i, "D").Value) Then
Set matches = regEx.Execute(.Cells(i, "D").Value)
ulice = Trim(matches(0).SubMatches(0))
popisne = Trim(matches(0).SubMatches(1))
Else
ulice = .Cells(i, "D").Value
popisne = ""
End If
' Zapíše rozdělené části do sloupců D a R
.Cells(i, "D").Value = ulice
.Cells(i, "R").Value = popisne
End If
Next i
End With
MsgBox "Rozdělení adres dokončeno!", vbInformation
End Sub
Dobrý den,
chvilku mi trvalo to rozchodit, nejsem moc zběhlý v xml. 
Aspoň mi to v práci uteklo a můžu domů
Mám Office 365 a tam mi to funguje, tak snad nebude problém s jinou verzí excelu.
Kdyžtak se na to podívejte. (viz příloha)
V Office RibbonX Editoru jsem upravil .xml viz kód
<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui" onLoad="Initialize">
<ribbon startFromScratch="false">
<tabs>
<tab id="TabFormular" label="Moje" keytip="f">
<group id="SkupinaNovyZaznam" label="nový záznam">
<button id="btnNovyZaznam" label="zadat nový" size="large" onAction="NovyZaznam_makro" imageMso="ReviewAcceptChangeMenu" />
<separator id="SeparatorNovyZaznam1" />
<button id="btnTisk" label="tisk" size="large" onAction="Tisk_makro" imageMso="FilePrint" />
</group>
<group id="SkupinaPocetStran" label="počet stran">
<toggleButton id="toggleNaJednuStranu" label="na 1 stranu" onAction="PocetStran1_makro" getPressed="GetPressedJednaStranu" />
<toggleButton id="toggleNaDveStrany" label="na 2 strany" onAction="PocetStran2_makro" getPressed="GetPressedDveStrany" />
</group>
<group id="SkupinaFormulare" label="tisk formuláře">
<checkBox id="chkPlech" label="PLECH" onAction="ChkPlech_makro" getPressed="GetPlechState" />
<checkBox id="chkTyc" label="TYČ" onAction="ChkTyc_makro" getPressed="GetTycState"/>
<checkBox id="chkTycObrna" label="TYČ obrana" onAction="ChkTycObrna_makro" getPressed="GetTycObrnaState" />
</group>
</tab>
</tabs>
</ribbon>
</customUI>
Ahoj,
tak trochu nechápu proč od řádku 5 až 12 nemá být žádný nalez, když taky obsahuje slovo "oprava"
Jinak zkus se na to podívat, co jsem poslal.
Ahoj,
viz "pravidla fóra"
3. Příloha - pro snazší zodpovězení dotazu je vždy užitečné připojit přílohu (nedoporučuje se vkládat odkazy na externí úložiště), která je názornější než tisíc slov ... Registrovaní uživatelé mohou vkládat přílohy:
- ve formátech: .gif .jpg .png .txt .zip .rar .tar .7z,
- s maximální velikostí 256 kB a
- názvy neobsahující diakritiku
- přílohu lze vložit i dodatečně v úpravě příspěvku
nebo v buňce A1 je název listu
=SVYHLEDAT(C3;NEPŘÍMÝ.ODKAZ("'"&A1&"'!B:F");5;0)
nebo
=VLOOKUP(C3;INDIRECT("'"&A1&"'!B:F");5;0)
1. co registr?
Otevři Editor registru (stiskni Win + R, napiš regedit).
Najdi klíč:
HKEY_CURRENT_USER\Software\Microsoft\Office\<verze>\Excel\AddIns
Zkontroluj, jestli zde odpovídá cesta k doplňku. Pokud ne, uprav ji.
2. co tak vložit makro do sešitu.
Private Sub Workbook_Open()
Dim addInPath As String
addInPath = "C:\Users\[TvůjProfil]\AppData\Roaming\Microsoft\AddIns\TabulkaBN.xlam"
If Not Application.AddIns("TabulkaBN").Installed Then
Application.AddIns.Add(addInPath).Installed = True
End If
End Sub
3. Co Vymazání mezipaměti Excelu
Zavři Excel.
Odstraň všechny soubory z:
C:\Users\[TvůjProfil]\AppData\Local\Microsoft\Office\16.0\
Znovu spusť Excel a načíst doplněk.
třeba takto?
Ahoj,
u Insert Formu jsem showModal nastavil z True na False, a teď jde vyhledávat i nadále.
Přidal jsem i časovač, tak se na to mrkni, popřípadě dej vědet jestli jsem to nepochopil špatně, to zadání
Uživatelské menu
\nFormulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Helios iNuvio
Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.
RSS nejnovější články