Příspěvky uživatele


< návrat zpět

Strana:  « předchozí  1 2 3 4 5 6 7 8 9   další » ... 10

Pole s povolenými znaky je v tomto případě zbytečná technika, použil jsem to z existující funkce co používám pro nahrazování diakritiky. Pro účely RZ to plně postačí takto:
strPovoleneZnaky = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"

'kontrola na povolené znaky (abecedu a číslice)
For x = 1 To Len(kj)
'znak po znaku se bude zkoumat jestli je ze seznamu (pole) povolených znaků
strX = Mid(kj, x, 1)
If InStr(1, strPovoleneZnaky, strX) = 0 Then
MsgBox strX & " není povolený znak pro SPZ!"
Exit Sub
End If
Next x

Nahraďte část svého kódu (po loop) tímto:
Sub Nova_KJ()

Dim kj As String
Dim jmeno As String, strX As String
Dim radek As Long, x As Integer, m As Integer
Dim aPovoleneZnaky As Variant
Dim boNalezeno As Boolean

aPovoleneZnaky = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "1", "2", "3", "4", "5", "6", "7", "8", "9", "0")

On Error Resume Next 'pokud uživatel stiskne klávesu ESC, kód skočí do řádku s "Exit Sub"

kj = InputBox("Zadejte novou RZ: (bez mezer, a speciálních znaků) - ukončit můžete klávesou ESC nebo kliknutím na křížek nebo na klávesu Cancel")

If Err.Number <> 0 Then 'pokud uživatel stiskne klávesu ESC, ukončí se makro
Exit Sub
End If

If kj = "" Then
Exit Sub
End If

'převeď to na velké a odstřel případné mezery
kj = Trim(UCase(kj))

'kontrola na počet znaků
If Len(kj) < 7 Then
MsgBox kj & vbCrLf & "to je příliš málo znakú pro RZ"
Exit Sub
End If

If Len(kj) > 7 Then
If vbNo = MsgBox(kj & vbCrLf & "Příliš mnoho znakú pro RZ!" & vbCrLf & "opravdu pokračovat?", vbYesNo) Then Exit Sub
End If

'kontrola na povolené znaky (abecedu a číslice)
For x = 1 To Len(kj)
'znak po znaku se bude zkoumat jestli je ze seznamu (pole) povolených znaků
strX = Mid(kj, x, 1)
boNalezeno = False
For m = LBound(aPovoleneZnaky) To UBound(aPovoleneZnaky)
If aPovoleneZnaky(m) = strX Then
boNalezeno = True
Exit For
End If
Next m
If boNalezeno = False Then
MsgBox strX & " není povolený znak pro SPZ!"
Exit Sub
End If
Next x

If Sheets("kj").Range("A2") = "" Then
radek = 2
Else
radek = Sheets("kj").Range("A" & Rows.Count).End(xlUp).Row + 1
End If
Sheets("kj").Range("A" & radek).Value = kj

tato podmínka je špatně:
If Not (IsUpper(kj) And _
IsNumeric(kj) And _
Len(kj) = 7 Or Len(kj) = 0 Or Len(kj) < 7) Then


za prvé kontrolovat velká malá písmena je zbytečná buzerace uživatele, u SPZ to kódem změňte na UCASE, u jména první velké a ostatní LCASE. Ale problém je IsNumeric(kj), což v případě SPZ nebude nikdy splněno

Tak jsem nakonec vygooglil kód, kterým se "plevelné" oblasti smažou:
Sub DeleteAllSheetNames()
Dim n As Name
For Each n In ThisWorkbook.Names
If Not n.Parent Is ThisWorkbook Then n.Delete
Next
End Sub

1

Fór je v tom, že na těch nově kopírovaných listech žádné oblasti (kromě oblasti tisku) nejsou. Přesto se do cílového souboru ze zdrojového překopírují úplně všechny oblasti co jsou v sešitu. Ještě budu testovat zdali se dají ty plevelné oblasti nějak automatizovaně mazat.
Ta myšlenka kódem tvořených dynamických oblastí zní zajímavě, ale zřejmě to přinese nutnost následných sekundárních změn v kódu. No nic, když to nepůjde jinak, tak to prubnu. Každopádně dík za radu

Taky se mi někdy stalo, že debugger hlásí tuto chybu a skočí na místo kódu, které s tím vůbec nesouvisí. A pak se ukáže, že jsem se uklepl někde jinde.

To nebyl kód na řazení, ale na zamčení listu tak, aby ho měl uživatel zamčený, ale pro kód aby zamčený nebyl. To getHSL1 je funkce, která vrací heslo, aby to o něco ztížilo hacknutí, takže místo toho tam musíš zadat heslo kterým se list odemyká. Ale samotný kód pro řazení je jiný, např. takhle
Sub TestRazeni()

Dim ws As Worksheet
Dim rOblast As Range

'zadefinuj zkratku pro list
Set ws = Worksheets("seznam")

'pokud tam je filtr, tak ho odepni
If ws.FilterMode Then ws.ShowAllData

'zadefinuj tabulku
Set rOblast = ws.Range("B2").CurrentRegion

'vzestupne razeni podle sloupce B a v druhem levelu sestupne podle sloupce D
rOblast.Sort Key1:=ws.Range("B2"), Order1:=xlAscending, Key2:=ws.Range("D2"), Order1:=xlDescending, Header:=xlYes

End Sub

Pokud to zamykáš ručně, tak i když tam je fajfka pro možnost Seřadit, tak to po zamčení řadit nejde ani podle jednoduchých kritérií, natož podle složitějších.

Ale pokud bys to chtěl řadit kódem, tak není problém. Dokonce to ani nemusíš odemykat, pokud to bude zamčeno kódem s atributem UserInterfaceOnly:=True. Třeba takhle:
ws.Protect GetHSL1, AllowFiltering:=True, UserInterfaceOnly:=True

Ahoj, mám excelový soubor pro správu citlivých dat, v němž používám neškodný vzorek vymyšlených osob.
Při uvolnění nové verze si do něj pak uživatel ručně nakopíruje "citlivé" listy z předchozí ostré verze - pomocí volby Přesunout nebo zkopírovat...
Jenomže s každým přikopírovaným listem dochází k duplikování pojmenovaných oblastí (i těch oblastí, které leží na jiných listech, než na tom kopírovaném). No a pak mu kolabují procedury, které pracují s pojmenovanými Range.

Co se s tím dá dělat? Dají se ty listy nakopírovat nějak jinak bez tohoto duplikačního efektu? Anebo třeba nějaký jiný trik jak procedurou ty blbé oblasti smazat?

Předem dík

Našel jsem radu proti tomuto efektu, akorát ještě nevím zdali to funguje, neboť ke zmenšování formuláře dochází sporadicky.

Že prý by mohlo pomoci v možnostech excelu zvolit na volbě Obecné - Při použití více monitorů volbu "Optimalizovat pro kompatibilitu". Neboť defaultně tam je volba "Optimalizovat pro vzhled".

Tak snad to pomůže...

Jak píše El Nino, pomocí polí je možné toto významně urychlit. Já měl fakt optimalizované makro bez polí, které potřebovalo přes 40 minut. Poté co jsem použil pro řešení pole, tak na to stačily 3 minuty. Ale bylo potřeba nejdřív nastudovat ty dynamické arraye a jejich vrtochy (např. že nejdřív se dynamická 2D array musela transponovat aby s ní šlo pracovat a na konci zase transpozice zpět). Přehled jednotlivých proměnných při ladění kódu s použitím array je uživatelsky mnohem méně přívětivý než u "klasiky"

Takže dle uvedeného linku je list zaručeně odemčen pokud platí všechny tři podmínky. Udělal jsem si na to funkci

Function ListZamcen(ws As Worksheet) As Boolean
With ws
If Not .ProtectContents And Not .ProtectDrawingObjects And Not .ProtectScenarios Then
ListZamcen = False
Else
ListZamcen = True
End If
End With
End Function


Předběžné testy hlásí, že to funguje. Díky

Ano, samovolné zmenšování formulářů pozoruju taky. Někdy se to zmenší až tak hrůzostrašně, že už je to nepoužitelné, ale to jsem zažil jednou, obvykle se to zmenší jen "snensitelně". Pak stačí jít do VBA prostředí, chytnout formulář za okraj a on sám skočí na původní velikost. Ale nevíš hodinu ani den kdy se to stane znovu.
Pozorováno na Office 365, 32 bit verzi. Jestli má na to vliv verze office, provozování na více monitorech či něco jiného jsem za těch pár let ještě spolehlivě nezjistil...

Ahoj, pro zjišťování zdali je daný list zamčený nebo ne (a podle toho např. nastavovat popis odemykacího/zamykacího tlačítka) jsem dosud postupoval takto:
If ActiveSheet.ProtectContents = True Then
Jenomže ve skutečnosti tím nezjišťuji, zdali je daný list zamčený, ale něco trošku jiného (viditelnost obsahu buňky v zadávacím řádku při zamčeném listě). A zrovna toto chování potřebuju změnit, takže musím se chytit něčeho jiného. Jak má ta podmínka správně znít? Dívám se do https://learn.microsoft.com/en-us/office/vba/api/excel.worksheet.protect, ale nenacházím to tam 4

Předem dík

Super, pomohlo to, díky 1


Strana:  « předchozí  1 2 3 4 5 6 7 8 9   další » ... 10

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

Formulář 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.

On-line nástroje