< návrat zpět

MS Excel


Téma: Ověření dat-správce názvů rss

Zaslal/a 17.4.2013 14:30

Jde nějak vymyslet (třeba i pomocí kódu, makra), aby v listu1 ve sloupci B nešlo zapsat klávesnicí malýma písmenama? Ve sloupci B je pomocí funkce ověření dat povolen seznam pomocí nadefinovaného názvu ve SPRÁVCI NÁZVŮ. Data do seznamu jsou čerpána z List2 sloupce B (jsou to pouze velká písmena).

Příloha: zip12950_sesit1.zip (8kB, staženo 24x)
Zaslat odpověď >

icon #012951
eLCHa
Nastavil bych to pouze na oblast, které se týká to ověření dat.
Třeba nějak takhle:

Private Sub Worksheet_Change(ByVal Target As Range)
Const VALIDATION_FORMULA As String = "=SEZNAM"

Dim sValidationFormula As String
sValidationFormula = vbNullString

On Error Resume Next
sValidationFormula = Target.Validation.Formula1
On Error GoTo 0
If sValidationFormula = VALIDATION_FORMULA Then
Dim bEvents As Boolean
bEvents = Application.EnableEvents
Application.EnableEvents = False

Target.Value = UCase(Target.Value)

Application.EnableEvents = bEvents
End If
End Sub
citovat
#012952
Opičák
Jelikož jsi měl v ověření dat vžd jen dvě písmena, řešil jsem to tak, že jich nezapíše excel více než dvě a to velká, i když píšeš malými. Je to obdoba toho co poslal eLCHa
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
Application.EnableEvents = False
Target.Value = UCase(Left(Target.Value, 2))
Application.EnableEvents = True
End If
End Sub
citovat
icon #012954
avatar
To enable events má svoje kúzlo, pokiaľ by mal jeden problém to použiť, tak tu je alternatívaPrivate Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 And Target.Value <> UCase(Target) And Not IsNumeric(Target) Then Target.Value = UCase(Target)
End Sub
citovat
#013043
avatar
Je to dobrý. Jen jedna maličkost, když označím a smažu více jak jednu položku ve sloupci B, tak to hodí chybu.citovat
#013046
Opičák
na začátek makra:
On Error Resume Next
na konec:
On Error Goto 0citovat
icon #013047
eLCHa
@Opičák

tady bych do toho nešel.
Co když bude chtít změnit více hodnot najednou?citovat
#013048
avatar
namiesto
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 And Target.Value <> UCase(Target) And Not IsNumeric(Target) Then Target.Value = UCase(Target)
End Sub

daj
Private Sub Worksheet_Change(ByVal Target As Range)
for each bunka in target
If bunka.Column = 2 And bunka.Value <> UCase(bunka) And Not IsNumeric(bunka) Then bunka.Value = UCase(bunka)
next bunka
End Sub
citovat
icon #013049
eLCHa
Private Sub Worksheet_Change(ByVal Target As Range)
Const VALIDATION_FORMULA As String = "=SEZNAM"

Dim bEvents As Boolean
bEvents = Application.EnableEvents
Application.EnableEvents = False

Dim sValidationFormula As String

Dim rArea As Range, rCell As Range
For Each rArea In Target.Areas
For Each rCell In rArea.Cells
If Not IsEmpty(rCell) Then
sValidationFormula = vbNullString
On Error Resume Next
sValidationFormula = rCell.Validation.Formula1
On Error GoTo 0
If sValidationFormula = VALIDATION_FORMULA Then
rCell.Value = UCase(rCell.Value)
End If
End If
Next rCell
Next rArea

Application.EnableEvents = bEvents
End Sub
citovat
icon #013050
eLCHa
@marjankaj

target může mít i více oblastí ;)citovat

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

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.

Aktivní diskuse

nezavre samo outlock

€Ł мσşqμΐτσ • 24.7. 9:01

kopirovanie s predosleho mesiaca

€Ł мσşqμΐτσ • 24.7. 8:49

automaticky generator VBA

Michalko • 23.7. 20:32

kopirovanie s predosleho mesiaca

ivana1 • 23.7. 19:25

nezavre samo outlock

peter2 • 23.7. 18:59

upozornění na již existující soubor

Kalous • 23.7. 17:41

Porovnání dat a doplnění.

lachis • 23.7. 12:39