Příspěvky uživatele

No, bez Select-u:

hárok1
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
sBunka = Target.Address
End Sub

hárok2
Private Sub Worksheet_Activate()
On Error Resume Next
Range(sBunka).Activate
End Sub

Modul
Public sBunka As String

Kvázijednoduchý maticový vzorec ? Pridal som aj list s výberom z rozbaľovacieho zoznamu.

Zatiaľ len na 1 list. Na všetky listy v zošite, je potreba myslieť ešte na výpis listov, ktoré sa odomknúť nepodarilo (pže užívateľ v odomknutom stave mohol zmeniť heslo manuálne)... Neviem, či na to budem mať večer čas. Zatiaľ toto...
Sub Zamknout_Odemknout()
Dim sPass As String

With wsData
If .ProtectContents Then
sPass = InputBox("Heslo k odemknutí listu:", "Odemknout list")
If sPass = "" Then MsgBox "Nebylo zadáno žádné heslo." & vbNewLine & "List nebyl odemčen.", vbExclamation: Exit Sub

On Error Resume Next
.Unprotect Password:=sPass
If Err.Number <> 0 Then
MsgBox "Zadané heslo není správné!" & vbNewLine & "List nebyl odemčen.", vbCritical: Exit Sub
Else
.Shapes("btnLock").OLEFormat.Object.Caption = "Zamknout"
End If
On Error GoTo 0

Else

sPass = InputBox("Heslo k zamknutí listu:", "Zamknout list")
If sPass = "" Then MsgBox "Nebylo zadáno žádné heslo." & vbNewLine & "List nebyl zamčen.", vbExclamation: Exit Sub

If sPass <> InputBox("Zadejte heslo ještě jednou:", "Potvrdit heslo") Then
MsgBox "Zadaná hesla se neshodují!" & vbNewLine & "List nebyl zamčen.", vbCritical: Exit Sub
Else
.Shapes("btnLock").OLEFormat.Object.Caption = "Odemknout"

On Error Resume Next
.Protect Password:=sPass
If Err.Number <> 0 Then
MsgBox "Při zamykání listu nastala chyba!" & vbNewLine & "List nebyl odemčen.", vbCritical, "Chyba": Exit Sub
.Shapes("btnLock").OLEFormat.Object.Caption = "Zamknout"
End If
On Error GoTo 0
End If
End If
End With
End Sub

A prečo chcete nahrádzať natívnu funkcionalitu Excelu (Revízia - Zabezpečiť hárok) ?

Píšete o liste, ale v cykle zamykáte/odomykáte všetky listy zošitu. Tak ako to je ?

Tie čísla sú vždy vzostupné po 1?
a) Ak nie, potom treba na dohľadanie nasledujúceho použiť :
=INDEX(Čísla!$A$2:$A$400;MATCH(H10;Čísla!$A$2:$A$400;0)+1)
=INDEX(Čísla!$A$2:$A$400;POZVYHLEDAT(H10;Čísla!$A$2:$A$400;0)+1)
b) Ak áno, potom stačí asi iba
=H10+1
c) Dá sa urobiť makro, ktoré sa Vás opýta na počet štítkov, a nakopíruje ich aj s číslami za Vás. Musí sa zistiť, či netreba vkladať zlomy strán, aby boli štítky správne vytlačené a nerozkladali sa "cez" stránky.

d) Alebo makro, ktoré bude postupne tlačiť zadaný počet lístkov, ale vytvorená bude len 1 stránka, v ktorej bude makro meniť čísla a posielať stránky na tlačiareň.

Iba nápad. Ale nepočíta sa s tým, že bude chýbať počiatočný alebo koncový údaj, a tiež sa počíta s tým, že sú hodnoty vzostupné, tak ako je v príklade.
=IF(B2<>"";B2;C1+(AVERAGE(MAX($C$1:$C1);MIN($B3:$B$12))-MAX($C$1:$C1)))

=KDYŽ(B2<>"";B2;C1+(PRŮMĚR(MAX($C$1:$C1);MIN($B3:$B$12))-MAX($C$1:$C1)))

EDIT: Vymenil som prílohu o 8:51, lebo som si uvedomil, že je nesprávna. :)

Od Office 2010 (vrátane) vyššie. Ak sa nemýlim.
Application.CommandBars.ExecuteMso ("PrintPreviewAndPrint")
Problém je, že makro ďalej pokračuje. Nečaká na žiadne voľby, tlač, na nič, a nevie ani o prípadnom zrušení tlače. Spomínam to preto, že treba na to myslieť.
Keď som pred rokmi hľadal nejaké riešenie pozastavenia makra na dobu zobrazenia tohto dialógu, nič dostupné ešte nebolo.

Napadá ma toto:
=INDEX(Stĺpec výsledku;MATCH(1;(SUBTOTAL(103;OFFSET(Prvý stĺpec;ROW(Prvý stĺpec)-2;;1))=1)*(Prvý stĺpec=E1);0))

=INDEX(Stĺpec výsledku;POZVYHLEDAT(1;(SUBTOTAL(103;POSUN(Prvý stĺpec;ŘÁDEK(Prvý stĺpec)-2;;1))=1)*(Prvý stĺpec=E1);0))

E1 - hľadaná hodnota
ROW(Prvý stĺpec)-2 - treba prispôsobiť podľa umiestnenia tabuľky, aby prvé číslo dalo 0
SUBTOTAL - dá True ak je riadok viditeľný
MATCH - nájde pozíciu prvej zhody
INDEX(Stĺpec výsledku ... - stĺpec v tabuľke, z ktorého sa má brať výsledok

=IF(INT(C2-B2)=0;"";INT(C2-B2)&" "&IF(INT(C2-B2)=1;"deň ";IF(INT(C2-B2)<5;"dni ";"dní ")))&TEXT(C2-B2-INT(C2-B2);"h:mm")&" hodín"
=KDYŽ(CELÁ.ČÁST(C2-B2)=0;"";CELÁ.ČÁST(C2-B2)&" "&KDYŽ(CELÁ.ČÁST(C2-B2)=1;"deň ";KDYŽ(CELÁ.ČÁST(C2-B2)<5;"dni ";"dní ")))&HODNOTA.NA.TEXT(C2-B2-CELÁ.ČÁST(C2-B2);"h:mm")&" hodín"

Dátum
=DATEVALUE(LEFT(A2;FIND("?";SUBSTITUTE(A2;"/";"?";3))-1))
=DATUMHODN(ZLEVA(A2;NAJÍT("?";DOSADIT(A2;"/";"?";3))-1))

Čas
=IFERROR(TIMEVALUE(REPLACE(A2;1;FIND("?";SUBSTITUTE(A2;"/";"?";3));""));"")
=IFERROR(ČASHODN(NAHRADIT(A2;1;NAJÍT("?";DOSADIT(A2;"/";"?";3));""));"")

Na overenie existencie predsa stačí iba:
=ISNUMBER((FIND(","&B1&",";","&A1&",")))
=JE.ČISLO((NAJÍT(","&B1&",";","&A1&",")))

Pozícia:
=IFERROR(FIND(","&B1&",";","&A1&",");0)
=IFERROR(NAJÍT(","&B1&",";","&A1&",");0)

Index:
=IFERROR(LEN(LEFT(A1;FIND(","&B1&",";","&A1&",")-1))-LEN(SUBSTITUTE(LEFT(A1;FIND(","&B1&",";","&A1&",")-1);",";""))+1;0)
=IFERROR(DÉLKA(ZLEVA(A1;NAJÍT(","&B1&",";","&A1&",")-1))-DÉLKA(DOSADIT(ZLEVA(A1;NAJÍT(","&B1&",";","&A1&",")-1);",";""))+1;0)

Počet:
=IF(A1="";0;LEN(A1)-LEN(SUBSTITUTE(A1;",";""))+1)
=KDYŽ(A1="";0;DÉLKA(A1)-DÉLKA(DOSADIT(A1;",";""))+1)

Súčet:
=SUMPRODUCT(--("0"&TRIM(MID(SUBSTITUTE(A1;",";REPT(" ";LEN(A1)));1+(ROW(OFFSET($A$1;;;LEN(A1)))-1)*LEN(A1);LEN(A1)))))
=SOUČIN.SKALÁRNÍ(--("0"&PROČISTIT(ČÁST(DOSADIT(A1;",";OPAKOVAT(" ";DÉLKA(A1)));1+(ŘÁDEK(POSUN($A$1;;;DÉLKA(A1)))-1)*DÉLKA(A1);DÉLKA(A1)))))

Výskytov:
=(LEN(A1)-LEN(SUBSTITUTE(A1;B1;"")))/LEN(B1)
=(DÉLKA(A1)-DÉLKA(DOSADIT(A1;B1;"")))/DÉLKA(B1)

Pr.

Priložte aj ten textový súbor. Takéto textopiplačky som mal kedysi rád :)

A to mazacie makro zmente len na tento 1 riadok kódu:
Sub Vymazat() ' Vymazat Makro
Range("A4") = 1
End Sub

Takto ???

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje