Příspěvky uživatele

aha, tak to jsem spatne pochopil, zkuste tohle:
Sub Heslo_otevreni()
Dim Cesta As String
Dim Nazev As String

Cesta = "c:\Documents and Settings\POKI\Plocha\"
Nazev = "Sesit_" & Date & ".xlsm"
ThisWorkbook.SaveAs Filename:=Cesta & Nazev, FileFormat:=xlOpenXMLWorkbookMacroEnabled, Password:="heslo_o"
End Sub

nejlepsi zpusob je myslim podminene formatovani (v priloze)

Jo, je to tak, akce provedene makrem nelze vzit zpet (a je to logicke).
Jedinou moznosti je naprogramovat makro, ktere provede provede inverzne...

Na overeni se pouzit funkce VBA IsNumeric(UserForm1.TextBox1)

Staci tedy napsat pred samotnou procedurou dat podminku, ze kdyz nebude pravda, ze je textbox numericky, vyskoci msgbox a po nem se procedura ukonci (Exit Sub).

Zkusil jsem tvuj sesit - funguje mi to dobre, bez chyby, tak nevim, v cem muze byt problem...

zvlastni, mne to funguje - jakou mas verzi Excelu? (ja 2007)

Mozna by to slo takto: Kdyz bude A1 = 0; tak se komentar zobrazi, kdyz bude A1 rovna jakekoliv jine hodnote, tak tam komentar nebude (funguje to na Seznam overeni dat i prepsani na klavesnici) - jen je dulezite definovat, jak ma vypadat ten komentar, zatim je jen napsan v tom kodu...
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$A$1" And Len(Target.Value) > 0 Then
On Error Resume Next
Koment = Range("c1").Comment.Text
If Err.Number = 91 Then
Else
Range("c1").Comment.Delete
End If

On Error GoTo 0

If Target.Value = 0 Then
With Range("c1")
.AddComment "Tohle je komentar pri A1 = 0"
.Comment.Shape.Select
End With
Selection.AutoSize = True
Target.Select
End If
End If

End Sub

No tak asi takhle:Sub hledat()
Dim i As Long
Dim j As Long
Dim S As String
Dim L As String
Dim Vysledek
Dim Obsah As String

S = ThisWorkbook.Name
L = ActiveSheet.Name
Workbooks.Add

For i = 1 To Workbooks(S).Worksheets(L).Cells(65000, 1).End(xlUp).Row
Obsah = ""
For j = 1 To Workbooks(S).Worksheets(L).Cells(65000, 2).End(xlUp).Row

Vysledek = InStr(1, Workbooks(S).Worksheets(L).Cells(j, 2), Workbooks(S).Worksheets(L).Cells(i, 1))
If Vysledek = 0 Then
Else
Workbooks(Workbooks.Count).Worksheets(1).Cells(1, i) = Workbooks(S).Worksheets(L).Cells(i, 1)
Obsah = Obsah & Chr(10) & Workbooks(S).Worksheets(L).Cells(j, 2)
End If
Next j
Obsah = Right(Obsah, Len(Obsah) - 1)
Workbooks(Workbooks.Count).Worksheets(1).Cells(Cells(65000, i).End(xlUp).Row + 1, i) = Obsah
Next i

With Workbooks(Workbooks.Count).Worksheets(1).Range(Cells(1, 1), Cells(1, i - 1))
.Font.Bold = True
.HorizontalAlignment = xlCenter
.Borders(xlEdgeBottom).LineStyle = xlContinuous
End With
End Sub

Potvrzuju, co napsal Jeza - i v 2007 a 2010 jsou tlacitka Formulare a prvku ActiveX (karta Vyvojar/Vlozit)

Po unloadovani formulare se z nej ztrati vsechny informace (zavreni sesitu samozrejme znamena unloadovani formulare), takze by se zamyslene hodnoty musely ulozit nekam do bunek a pri otevreni znovu natahnout do formulare

otazka je, co myslite formularem - opravdovy userform nebo proste jen list excelu?

Oboji je mozne nejakym zpusobem nastavit tak, aby se zobrazil, jak potrebujete, bude to asi ale chtit nejake makro pri spusteni...

No - zrovna nevim, jak bych to udelal (ale urcite by to nebyl problem), ALE to je neco, co bych rozhodne nedoporucoval, protoze se s tim pak uz neda nic delat - navic by zobrazeni bylo podobne.

Preferuji vzdy co zaznam, to bunka, protoze s takovyma informacema se da dal pracovat - to, co zadas je proti jakykoliv logice, takze se o to ani nebudu pokouset

co takhle:
Sub hledat()
Dim i As Long
Dim j As Long
Dim S As String
Dim L As String
Dim Vysledek
S = ThisWorkbook.Name
L = ActiveSheet.Name
Workbooks.Add

For i = 1 To Workbooks(S).Worksheets(L).Cells(65000, 1).End(xlUp).Row
For j = 1 To Workbooks(S).Worksheets(L).Cells(65000, 2).End(xlUp).Row

Vysledek = InStr(1, Workbooks(S).Worksheets(L).Cells(j, 2), Workbooks(S).Worksheets(L).Cells(i, 1))
If Vysledek = 0 Then
Else
Workbooks(Workbooks.Count).Worksheets(1).Cells(1, i) = Workbooks(S).Worksheets(L).Cells(i, 1)
Workbooks(Workbooks.Count).Worksheets(1).Cells(Cells(65000, i).End(xlUp).Row + 1, i) = _
Workbooks(S).Worksheets(L).Cells(j, 2)
End If
Next j
Next i

With Workbooks(Workbooks.Count).Worksheets(1).Range(Cells(1, 1), Cells(1, i - 1))
.Font.Bold = True
.HorizontalAlignment = xlCenter
.Borders(xlEdgeBottom).LineStyle = xlContinuous
End With
End Sub

NE (nebo o tom aspon nevim)

co takhle:
Sub mail()
ActiveSheet.Copy
ActiveWorkbook.Protect "Heslo", True, False
With Application
.Dialogs(xlDialogSendMail).Show _
"blbla@neco.cz", _
"Pošta!"
End With
ActiveWorkbook.Close Savechanges:=False
End Sub

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje