- Katılım
- 11 Mart 2005
- Mesajlar
- 3,062
- Excel Vers. ve Dili
- Office 2013 İngilizce
Merhabalar,
Ekli dosya "Worksheet_Change" ve "Worksheet_SelectionChange" olaylarında;
seçilen hücrede otomatik veri doğrulama oluşturması için aşağıdaki kodlar mevcut;
Yalnız dosyaı açıp kapattıkten sonra ekli görseldeki açarken ekli hata mesajını veriyor.
sıfırdan dosya oluşturuyordum, kaydettikten sonra kapatıp açtıktan sonra tekrar aynı hatayı vermekte;
işin içinden bir türlü çıkamıyorum, bu nedenle size dosyayı paylaşmk durumda kaldım.
yardımcı olursanız çok sevinirim, diğer durumda kafayı yiyeceğim.
desteğiniz için şimdiden teşekkürler,
Ekli dosya "Worksheet_Change" ve "Worksheet_SelectionChange" olaylarında;
seçilen hücrede otomatik veri doğrulama oluşturması için aşağıdaki kodlar mevcut;
Yalnız dosyaı açıp kapattıkten sonra ekli görseldeki açarken ekli hata mesajını veriyor.
sıfırdan dosya oluşturuyordum, kaydettikten sonra kapatıp açtıktan sonra tekrar aynı hatayı vermekte;
işin içinden bir türlü çıkamıyorum, bu nedenle size dosyayı paylaşmk durumda kaldım.
yardımcı olursanız çok sevinirim, diğer durumda kafayı yiyeceğim.
desteğiniz için şimdiden teşekkürler,
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRng As Range
Dim metin As String
Dim t As Byte
Dim c As Integer
On Error Resume Next
If Target.Columns.Count > 1 Then Exit Sub
If Target.Rows.Count > 1 Then Exit Sub
If Target.Column < 6 Or Target.Column > 11 Then Exit Sub
c = Target.Column
If c = 6 Or c = 11 Then
If Target.Value = "" Then
Target.Offset(, 1).Validation.Delete
Target.Offset(, 1) = ""
Exit Sub
End If
metin = Target.Value
Select Case metin
Case "Round": t = 1
Case "Oval": t = 4
Case "Emerald": t = 7
Case "Pear": t = 10
End Select
If t > 0 Then
Set myRng = Target.Offset(, 1)
myRng = ""
dataValid myRng, t
End If
Set myRng = Nothing
End If
End Sub
Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim c As Integer
Dim t As Integer
On Error Resume Next
If Target.Columns.Count > 1 Then Exit Sub
If Target.Rows.Count > 1 Then Exit Sub
If Target.Value <> "" Then Exit Sub
If Target.Column <> 6 And Target.Column <> 11 Then Exit Sub
If ActiveCell.Borders.Item(xlEdgeLeft).LineStyle <> 1 Then Exit Sub
t = validationtype(Target)
If t > 2 Then Exit Sub
Dim MyList(3) As String
MyList(0) = "Round"
MyList(1) = "Oval"
MyList(2) = "Emerald"
MyList(3) = "Pear"
c = Target.Column
If c = 6 Or c = 11 Then
With Target.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:=Join(MyList, ",")
End With
End If
End Sub
Ekli dosyalar
-
21.2 KB Görüntüleme: 12
-
33.4 KB Görüntüleme: 12
-
26.6 KB Görüntüleme: 3