< návrat zpět
MS Excel
Téma: Ověření dat-správce názvů 
Zaslal/a lachatol 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: 
12950_sesit1.zip (8kB, staženo 24x)
eLCHa(17.4.2013 15:36)#012951
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 SubcitovatOpičák(17.4.2013 15:39)#012952 
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 Subcitovat AL(17.4.2013 16:54)#012954 
To enable events má svoje kúzlo, pokiaľ by mal jeden problém to použiť, tak tu je alternatíva
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 Subcitovatlachatol(22.4.2013 14:04)#013043 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.
citovatOpičák(22.4.2013 14:45)#013046 na začátek makra:
On Error Resume Next
na konec:
On Error Goto 0
citovat eLCHa(22.4.2013 15:13)#013047 @Opičák
tady bych do toho nešel.
Co když bude chtít změnit více hodnot najednou?
citovatmarjankaj(22.4.2013 15:36)#013048 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 eLCHa(22.4.2013 15:36)#013049 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 Subcitovat eLCHa(22.4.2013 15:49)#013050 @marjankaj
target může mít i více oblastí ;)
citovat
RSS nejnovější články