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í
Nebo tohle, předpokldádam že máš office 32bit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetForegroundWindow Lib "user32" _
(ByVal hwnd As Long) As Long
Sub OpenExistingNotepadAndSendText()
Dim strX As String
Dim hwndNotepad As Long
' Text k odeslání
strX = "Toto je testovací text do nového listu Notepadu."
' Najdi okno Notepadu
hwndNotepad = FindWindow("Notepad", vbNullString)
If hwndNotepad = 0 Then
' Notepad není spuštěn, otevři ho
Shell "Notepad", vbNormalFocus
' Chvilku počkej, než se Notepad otevře
Application.Wait Now + TimeValue("00:00:02")
' Najdi okno Notepadu znovu
hwndNotepad = FindWindow("Notepad", vbNullString)
End If
' Pokud bylo okno nalezeno
If hwndNotepad <> 0 Then
' Nastav fokus na okno Notepadu
SetForegroundWindow hwndNotepad
' Otevři nový list (Ctrl+N)
SendKeys "^(n)", True
' Počkej malou chvíli na vytvoření nového listu
Application.Wait Now + TimeValue("00:00:01")
' Odešli text do nového listu
SendKeys strX, True
Else
MsgBox "Nepodařilo se najít nebo otevřít okno Notepadu.", vbExclamation
End If
End Sub
Ahoj,
1. V příloze zasílám možnost jak by mohla fungovat Alokace, jelikož ale nevím jak by vypadala kritéria a kam by se měli zapisovat hodnoty, tak to není úplně ono. Chtělo by to vice specifikovat.
2. Problém se sdílením souboru, tady bohužel nemám zkušenosti, možná poradí někdo jiný
3. Doladil jsem "Workbook_Open" co se týče hesel.
4. Vynucení otevření souboru v Office, stejný jako u bodu 2 nemám zkušenosti.
zdravím,
přesne jak píše "Ladys" tabIndex nastavit dle pořadí jak potřebujete, nebo použít "SetFocus" viz kód.
Ale první tlačítko bych dal tedy TabIndex = 0
druhé tlačítko TabIndex = 1
třetí tlačítko TabIndex = 2
Private Sub UserForm_Initialize()
' Nastaví focus na první tlačítko při načtení UserFormu
tl1.SetFocus
End Sub
Private Sub tl1_Click()
' Po stisknutí tl1 se nastaví focus na tl2
tl2.SetFocus
End Sub
Private Sub tl2_Click()
' Po stisknutí tl2 se nastaví focus na tl3
tl3.SetFocus
End Sub
Private Sub tl3_Click()
' Po stisknutí tl3 se nastaví focus na tl1 (cyklus)
tl1.SetFocus
End Sub
vložil jsem progress bar do vašeho sešitu pro ukázku.
mazání provedete příkazem z kontextového menu. (pravým tlačítkem myši, vybrat z menu "Smazat")
Dobrý den,
můžete napsat v jakém formátu vypadá jeden řádek?
třeba "MenoPriezviskoTitul1.Titul2.Oddelenie1" jde mi o to jestli mají za titulem tečku nebo ne? jestli má někdo dvě jména a 1 přímení, nebo titul před jménem titul za jménem. proste jaké jsou různé varianty?
* edit: koukám že už to funguje tak nic
Dobrý den,
až teď vidím že mail od Vás skončil ve spamu , podívám se na to a pošlu zpátky na ten samý email.
*opraveno a zasláno emailem
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
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.