V tom príklade od "AL" nahraď :
If pass <> "HESLO" Then Exit Sub
za
If pass <> "HESLO" Then
MsgBox ("špatné heslo")
Exit Sub
End If
Po tomto bloku nasleduje Tvoj kód, ktorý sa vykoná keď je heslo správne, a ukončuje ho až ukončenie procedúry "End Sub"
Obdobne bez problémov upravíš aj ostatné príklady...
Predošlý súbor som doplnil o formulár s overením heslom na prvé tlačítko. Heslo je "abc". Treba potom samozrejme zmeniť heslo pre vstup do makier, ktoré je tiež "abc" :
Vo VBA označ tento VBAProject(Zamknut tlacitko.xlsm) - Tools - VBAProject Properties - Protection - 2x heslo
Alebo aj niečo takéto by mohlo pomôcť. Toto som urobil na FormBtn. Na ActiveX použiť Enabled vlastnosť, ktorú FormBtn nemajú.
Aktivuj si v makre zrušením alebo pridaním "'" pred daný riadok buď:
Okamžitá tlač
ActiveSheet.PrintOut
Náhľadové okno
ActiveSheet.PrintPreview
To nové náhľadové okno
Application.CommandBars.ExecuteMso ("PrintPreviewAndPrint")
Samozrejme iba jednu možnosť si tam daj.
Keď dáš tlačítko "Zaslat odpověd", tak nad políčkom kam píšeš, je "Příloha" a vedľa je tlačítko "Vybrať súbor". Cez toto vyberieš u Teba v PC uložený archív RAR, so zabaleným súborom/súbormi.
Skús ako som ti písal, ten súbor stiahnuť do PC, a z PC ho otvor. Neotváraj ho rovno zo siete. Tá metóda DownloadFile(), čo som ti poslal mi funguje. Samozrejme sa to dá prispôsobiť, že myURL bude parameter...
No to nebude také jednoduché. Width je iba na čítanie, ColumnWidth je pre zápis, obe v iných "nešťastných" jednotkách. Písmo v ďalších jednotkách. Pomer medzi dvomi jednotkami šírky je úplne iný ako pomer medzi dvomi jednotkami výšky. Každý font (+rez) má iné rozmery...
Jedno "riešenie" by mohlo byť takéto:
-bude tam 1 skrytý (Visible=False) Label
-tomu nastavíme potrebné atribúty fontu z bunky
-z tohoto Labelu (LTest) získame šírku textu
-túto šírku prepočítame na "idiotské" jednotky bunky
-zmeníme veľkosť bunky (teda mení sa celý riadok a stĺpec)
a v poslednom bode nastávajú 2 problémy:
1. zmena veľkosti bunky sa neaktualizuje, pokiaľ na bunku nekliknem. Nepomáha Application.ScreenUpdating, ani Calculate, ani Select, ani Activate.
2. v bunke sú okolo textu medzery. Aj keď je odsadenie =0, aj tak tam sú. Potrebujeme získať veľkosti týchto medzier a pripočítať ich k nám vypočítaným hodnotám, ak to neurobíme, dostaneme "####" lebo sa text tesne nevojde do bunky, pretože Label tieto medzery nemá. Nemôžeme ich pripočítať ale napr. percentuálne, lebo veľkosťou a typom písma sa to mení nepercentuálne.
Takže ako to vyriešiť.
PS: Pre každý stĺpec aj riadok môže byť logicky iba jedna bunka takto ošéfovaná, lebo by si navzájom menili hodnoty. Použiť stačí len ten jeden Label pre všetky.
ListBox mi funguje tak, že pokiaľ píšeš do neho (keď si naň kliknutý) bez prerušenia trvajúceho cca 1-2s, tak ti označí prvý riadok spĺňajúci to čo píšeš. To je ale nepraktické, keďže akonáhle na chvíľku prestaneš, tak berie od teba nový text na nové hľadanie. Neviem ako sa to dá vyriešiť priamo v LB, ale môžeš to vyskúšať urobiť aj takto:
Tak aj cieľ naformátuj ako text.
1. metóda cyklus - netreba cieľ formátovať vopred ako text
2. metóda treba vopred cieľ formátovať ako text, pri množstve hodnôt je rýchlejšia, ako prístup po jednom.
Sakra, až teraz som si náhodou všimol, že v tom mojom vzorci som dal o jedno "y" v rýchlosti menej
Takže oprava z
"=CARDS_"&TEXT(Sešit1!A2;"ddmmyyy")
na
="CARDS_"&TEXT(Sešit1!A2;"ddmmyyyy")
ale funguje tak či tak.
V CZ sa "yyyy" zamieňa na "rrrr" tak ako píše "lubo".
Vôbec nejde len o pripojenie sa k tebe na sieťový zdroj. Ide o celý návrh. Ale neva. Skúsil by som súbor najskôr stiahnuť na PC a až potom spracovávať:
Sub DownloadFile()
Dim myURL As String
myURL = "http://sheetsibca.pbworks.com/w/file/fetch/38012029/excel%20lesson%203%20test.xlsx"
Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False, "username", "password"
WinHttpReq.send
myURL = WinHttpReq.responseBody
If WinHttpReq.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write WinHttpReq.responseBody
oStream.SaveToFile "Z:\chyba\excel%20lesson%203%20test.xlsx", 2 ' 1 = no overwrite, 2 = overwrite
oStream.Close
End If
' Súbor treba po použiťí Zatvoriť a potom ZMAZAT týmto príkazom
Kill ("Z:\chyba\excel%20lesson%203%20test.xlsx")
End Sub
SUMIFS mi dáva chybu, tak spočítaš 2 SUMIF :
Sub pokus()
' VARIANT 1
With Sheets("Sheet1")
.Range("K13") = Application.SumIf(Sheets("Sheet2").Range("C2:C12"), "=2615100103", Sheets("Sheet2").Range("F2:F12")) + _
Application.SumIf(Sheets("Sheet2").Range("C2:C12"), "=2615100104", Sheets("Sheet2").Range("F2:F12"))
' ostatné obdobné ...
End With
' VARIANT 2
With Sheets("Sheet1")
.Range("K13").Formula = "=SUMIF(Sheet2!C2:C12,""=2615100103"",Sheet2!F2:F12)+SUMIF(Sheet2!C2:C12,""=2615100104"",Sheet2!F2:F12)"
.Range("K13").Value = .Range("K13").Value
' ostatné obdobné ...
End With
End Sub
Možno exituje možnosť vytvoriť a spravovať Objekty Cells či Listy len v pamäti, ale to mi nič nehovorí. Tak ma napadá len použiť kópiu na skrytom liste.
Funkcia CopyRng skopíruje zvolenú Range na skrytý list, kde môže byť upravená a následne použitá.
Skopíruje sa:
-umiestnenie
-hodnoty
-vzorce
-formátovanie bunky
-formátovanie textu
-podmienené formátovanie
-šírka stĺpcov
Ak je treba kopírovať aj výšku riadku, to treba urobiť cez cyklus po jednom.
Inak neviem pomôcť s týmto druhým problémom.
Vytvoril som ti vlastnú funkciu SUMIFS v makre, ktorá funguje tak ako chceš. A funguje aj v makre, aj v zošite.
Asi takto...
Dve verzie:
1. - Stĺpec B aj zoraďuje jedinečné mená (bude logické mať opačne meno->priezvisko)
2. - Stĺpec C iba Extrahuje jedinečné mená
Je to nastavené po riadok č.100. Mená po riadok č. 100 berie zo stĺpca A automaticky (dynamický názov "Ziaci").
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.