Příspěvky uživatele
< návrat zpět
zmeň =HYPERLINK("E:\00_makro_punch_list\foto_dokumentace\A4-100-016\IMG_4810.JPG\";"IMG_4810.JPG")
na
=HYPERLINK("E:\00_makro_punch_list\foto_dokumentace\A4-100-016\IMG_4810.JPG";"IMG_4810.JPG")
máš tam navyše lomítko.
Mne osobne viac vyhovuje tvorba klikacích buniek ručne (cez CTRL-K) a nie vzorcom = HYPERLINK, ten môže robiť galibu pri inojazyčných exceloch.
Myslím že je to v tom, že heslo znie ako preddefinovaný názov excelu pre nejaký objekt, v tvojom prípade názov stĺpca. A mimochodom - také krátke heslo je ľahko prelomiteľné, nedoporučujem ho používať, skús nejaké dlhšie a komplikovanejšie. Preto by možno pomohlo použiť a zadefinovať toto heslo ako konštantu. Excel 2013 robí navyše so súborom E2007 prevody na novšiu verziu a to tiež niečo trvá.
Len tak prikladám kód ktorý by ti mohol napovedať niečo aj o Dim
'zamkne všetky listy
Public Sub ProtectGroupedSheets()
Const csPASSWD As String = "drowssap"
Dim mySheets As Sheets
Dim actSheet As Worksheet
Dim wkSht As Worksheet
Set actSheet = ActiveSheet
Set mySheets = ActiveWindow.SelectedSheets
actSheet.Select
For Each wkSht In mySheets
wkSht.Protect Password:=csPASSWD
Next wkSht
actSheet.Select
mySheets.Select False
End Sub
'odomkne všetky listy
Public Sub UnProtectGroupedSheets()
Const csPASSWD As String = "drowssap"
Dim mySheets As Sheets
Dim actSheet As Worksheet
Dim wkSht As Worksheet
Set actSheet = ActiveSheet
Set mySheets = ActiveWindow.SelectedSheets
actSheet.Select
For Each wkSht In mySheets
wkSht.Unprotect Password:=csPASSWD
Next wkSht
actSheet.Select
mySheets.Select False
End Sub
Len tak narýchlo:
Sub vymaz()
If Dir("C:\cvm\*.xls") <> "" Then
Kill "C:\cvm\*.xls"
End If
End Sub
Ahoj, prepísaniu ešte možno zabrániť aj zákazom vstupu do oblasti, kde sú dáta.Tým vlastne nedostane možnosť niečo zmeniť. Obyčajný užívateľ to neprekoná. Napr. zachytením udalosti SelectioChange umiestnenej cez VBA nie v module ale v konkrétnom liste:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim oblast As Range
Set oblast = Intersect(Target, [a1:c5])
If Not oblast Is Nothing Then Target.Next.Select
End Sub
Tu sa jedná o oblasť A1:C5, treba si samozrejme upraviť podľa seba a dáta v súbore podľa možnosti dať do nejakej súvislejšej oblasti.
Mala by stačiť procedúra
Sub TriedeniePoRows()
Dim iRow As Integer
iRow = 1
Do Until IsEmpty(Cells(iRow, 1))
Rows(iRow).Sort _
Key1:=Cells(iRow, 1), _
Order1:=xlAscending, _
Header:=xlGuess, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlLeftToRight
iRow = iRow + 1
Loop
End Sub
Ahoj, s využitím eventu Change by to malo fungovať.
Píše sa do bunky A1, v B1 spočítava a v C1 je počet zápisov. Procedúru treba vložiť vo VBA do listu, nie do modulu (píšem pre istotu 
).
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Address <> "$A$1" Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
If IsEmpty(Target) Then Exit Sub
If Not IsNumeric(Target.Value) Then Exit Sub
Application.EnableEvents = False
On Error GoTo ERRORHANDLER
Target.Offset(0, 1).Value = _
Target.Offset(0, 1).Value + Target.Value
Target.Offset(0, 2).Value = _
Target.Offset(0, 2).Value + 1
ERRORHANDLER:
Application.EnableEvents = True
End Sub
Dopyt bez prílohy je ako mobil bez displeja 
Skús kontigenčú tabuľku a jej automatický prepočet využitím udalosti
Tak neviem, v zadaní si nápísal :"A ked zafarbim bunku A2 (napr na cerveno) chcem aby sa automaticky zafarbila aj bunka D2 na cerveno" , teraz že zadáš hodnotu a farbu. Myslím že 99% úspechu vyriešenia je priložiť vzorový súbor, kde na jednej stránke dáš ako to máš, na druhej ako by si to chcel mať, lebo dodatočné rozvíjanie podmienok je znechucujúce ...
Ahoj, ja by som zvolil iný prístup, použil nástroj Fotoaparát nad bunkou D2. Mám rôzne často používané tlačítka na paneli Rýchly prístup, viď v priloženom súbore.
Mám v archíve toto, kedy sa predpokladá uloženie v rovnakom adresári, oblasť je určená používaná :
Sub SaveAsTXT()
Dim Range As Object, Line As Object, Cell As Object
Dim StrTemp As String
Dim Separateur As String
Separateur = " "
Set Range = ActiveSheet.UsedRange
'ak nie je zadaná cesta, uloží podľa nastavenia Excelu -
'Nástroje - Možnosti - Obecné - výchozí umístení souboru !!
Open "Text_CSV2.txt" For Output As #1
For Each Line In Range.Rows
StrTemp = ""
For Each Cell In Line.Cells
StrTemp = StrTemp & CStr _
(Cell.Text) & Separateur
Next
Print #1, StrTemp '= " "
Next
Close
End Sub
Ahoj, možno pomôže inšpirácie z priloženého súboru xls.
Na liste1 a 2 sú príklady, v module je kód
Havran
Uživatelské menu
\nMenu
On-line nástroje
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
RSS nejnovější články