Rýchlo som to testol. Vaše riešenie je určo elegantnejšie. Moje nemá ešte ošetrené vloženie 2 des. čiarok, takže Vaše je aj správnejšie. Nech si ho len dotyčný ak chce doplní o ENTER pre opustenie TextBoxu.
PS: Tiež Vám nejde Editovať predošlý príspevok v ktorom je CODE ? Moje staršie príspevky v ktorých nieje CODE majú voľbu "upravit", tie s CODE nie. Iba jeden krát som zazrel "upravit" na prisp. s CODE, opravil, dal Uložit zmeny, a namiesto opravy mi dalo nový príspevok s vlastnou citáciou. Rovnako na všetkých prehliadačoch. Win aktuálny, skúsim ešte Javu updatnúť...
@eLCHa: "vknullstring" ... samozrejme vbNullString
Aj by som to opravil, ale zmizla mi na tablete možnosť Edit.
A formát ešte checknem niekedy.
Ten Váš kód snáď dnes vyskúšam tiež.
A tem KeyCode : Ja som si to tiež neskôr uvedomil, že to nieje kód znaku ale klávesy. Človeka všetko nenapadne hneď, ale zrovna tie kódy som mal zistené pokusným stlačením ďaleko skôr ako z nápovedy.
3:26 Poďme už spať...
=IF(B2>C2;IF(B2-C2<D2;B2-C2;D2);0)
???
Tie kódy sú fakt divné, svätá pravda. Musel som si pre istotu každý vyčítať za behu. Ale snáď to bude fachať.
Ja som to tiež skúšal spracovať v jednom vzorci, cez SUBSTITUTE/DOSADIT v matici, no to sa mi nepodarilo. Ono totiž ten vzorček dáva pole už upravených znakov, a napadlo ma ho indexovať v SUBSTITUTE v matici a nahradiť nimi pôvodné, žiaľ neúspešne.
Riešenie je to zaujímavé.
No obaľte ten vzorec do IFERROR()
=IFERROR(VLOOKUP(Tabuľka2[@Tovar];Tabuľka2;2;FALSE);"")
=IFERROR(SVYHLEDAT(Tabuľka2[@Tovar];Tabuľka2;2;NEPRAVDA);"")
Napr.
Ešte by stálo za to poukázať na možný problém s EnableEvents. Ak totiž volané makro skončí chybou, debuguje, užívateľ to následne Stopne, lebo si nebude vedieť rady, tak udalosti ostanú vypnuté. V tomto prípade je pravdepodobnosť dosť malá, že pri kopírovaní nastane chyba, ale ak by sa jednalo o zložitejšie makro, tak by som odporúčal procedúry zmeniť na funkcie, obaliť ich On Error kontrolou, a riadiacej procedúre poslať info o prípadnej chybe. Aby užívateľ vedel o chybe (to by zistil aj bez toho), ale aby EnableEvents ostalo zapnuté.
Teda napr.:
Function Makro1() As Boolean
'
'Nepřestupný
On Error GoTo KONIEC
Range("BB45:BE61").Copy Destination:=Range("AF45:AI45")
Exit Function
KONIEC:
Makro1 = True
End Function
Function Makro2() As Boolean
'
' Přestupný
On Error GoTo KONIEC
Range("AU45:AX61").Copy Destination:=Range("AF45:AI45")
Exit Function
KONIEC:
Makro2 = True
End Function
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Chyba As Boolean
If Not Intersect(Target, Cells(2, 3)) Is Nothing Then
Application.EnableEvents = False
If Cells(2, 3) Mod 4 = 0 Then Chyba = Makro2 Else Chyba = Makro1
If Chyba Then MsgBox ("Nastala chyba.")
Application.EnableEvents = True
End If
End Sub
Zmenil som Vám tam kopírovanie na oveľa jednoduchšie, ak už ten február/únor chcete riešiť takto.
Myslíte toto ? - vložiť kód do listu "List2 (Plán)"
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Cells(2, 3)) Is Nothing Then
Application.EnableEvents = False
If Cells(2, 3) Mod 4 = 0 Then Call Makro2 Else Call Makro1
Application.EnableEvents = True
End If
End Sub
Takto by to mohlo fungovať:
Private Sub tbNumber_GotFocus()
tbNumber.Text = Replace(tbNumber.Text, Chr(160), vknullstring) 'Odstránenie formátovaných medzier
'''tbNumber.Text = Cells(3, 2) 'Voľba pre uchovanie neupravenej hodnoty v bunke, predošlý riadok zrušiť
End Sub
Private Sub tbNumber_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If Shift Then KeyCode = 0 'Ctrl, Shift, Alt
Select Case KeyCode
'8 BackSpace
'37 a 39 šípka vľavo a vpravo
'46 Delete
'48..57 0 až 9
'96..105 numerické čísla
'109 a 191 num "-" a "-"
'110 a 188 num "," a ","
Case 8, 37, 39, 46, 48 To 57, 96 To 105
Case 109, 110, 188, 191: If Not IsNumeric(tbNumber.Text) Then KeyCode = 0
Case 13: tbNumber.TopLeftCell.Offset(1, 0).Activate
Case Else: KeyCode = 0
End Select
'''Cells(3, 3) = tbNumber.Text 'Voľba pre uchovanie neupravenej hodnoty v bunke
End Sub
Private Sub tbNumber_LostFocus()
tbNumber.Text = Format(tbNumber.Text, "#.##0") 'Naformátovanie
End Sub
To prvé bol iba ujo guugl z tabletu od kávy. Ale tento kód mne funguje, ale načo je to dobré ???
Iba z tabletu, inšpirujte sa z tohoto kódu zo stackoverflow
Public Sub UserForm_Initialize()
TextBox6.Text = Format(Number, "0.0000")
End Sub
Private Sub TextBox6_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If IsNumeric(TextBox6.Value) Then
TextBox6.Text = Format(TextBox6, "0.0000")
End If
End Sub
Private Sub TextBox6_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
'// Disregard keys other than 0-9/period/minus sign.
If Shift Then KeyCode = 0
Select Case KeyCode
Case 8, 13, 46, 48 To 57, 96 To 105, 109, 110, 189, 190
Case Else
KeyCode = 0
End Select
End Sub
Je z formulára, ale to snáď jasné.
V podobnej téme som radil toto
EDIT:
Tu máte príklad. Otázkou je, či tá Vaša aktualizácia vyvolá metódu Change, resp. neviem ako to budete aktualizovať, či nejakým SQL dopytom, či časovaným makrom, ...
Zabudnutá téma ?
Pre ListBox na liste
...
Dim s As String, i As Integer
With Worksheets("List2").ListBoxes("lbVyber") 'Je vhodné si LB premenovať
For i = 1 To UBound(.List)
If .Selected(i) Then s = s & IIf(s = "", "", ", ") & .List(i)
Next i
End With
.TextBody = s
...
Pre ListBox na UserForm-e
...
Dim s As String, i As Integer
With UserForm1.lbVyberForm
For i = 0 To .ListCount - 1
If .Selected(i) Then s = s & IIf(s = "", "", ", ") & .List(i)
Next i
End With
.TextBody = s
...
CheckBox nevyvoláva Worksheet_Change. Treba použiť fintu, skopírovania prepojenej bunky do inej bunky, a to vyvolá Calculate metódu. Viz príloha.
Iným riešeným by bolo použitie CheckBoxu ActiveX, ktorý ma OnClick metódu.
Presne tak:
Function ftbCheck(name As String) As Boolean
Dim Exist As Boolean
On Error Resume Next
Exist = Not ThisWorkbook.Worksheets("Hárok1").OLEObjects.Item(name) Is Nothing
ftbCheck = Exist
End Function
Sub test()
MsgBox ftbCheck("TextBox2")
End Sub
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.