Veri Dogrulama Listesini Combobox’a Cevirme

list_combo

 

Yukarida gormus oldugunuz listeleme yontemi bir combobox kullanimini gostermektedir. Combobox icerisinde harfle git, sirala gibi islemler yapilabilmektedir. Ornek calismamisda cok isinize yarayacagini dusundugum bir calisma olucak.

Normalde veri dogrulama ile liste kullandiginiz alanlarda cift tikladiginizda combox cikmasi ve secilen verinin ilgili hucreye enter veya tab tusuyla yazilmasi.

Option Explicit
Private Sub TempCombo_KeyDown(ByVal _
        KeyCode As MSForms.ReturnInteger, _
        ByVal Shift As Integer)
    'Combobox'i sakla, enter,tab ile cik
    Select Case KeyCode
        Case 9
            ActiveCell.Offset(0, 1).Activate
        Case 13
            ActiveCell.Offset(1, 0).Activate
        Case Else
            'bos
    End Select

End Sub


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim metin As String
Dim TempCombo As OLEObject
Dim sayfa As Worksheet
Dim sayfaListesi As Worksheet
Set sayfa = ActiveSheet
Set sayfaListesi = Sheets("Veri")
Cancel = True
Set TempCombo = sayfa.OLEObjects("TempCombo")
  On Error Resume Next
  With TempCombo
    .ListFillRange = ""
    .LinkedCell = ""
    .Visible = False
  End With
On Error GoTo Hata_tutucu
  If Target.Validation.Type = 3 Then
    Application.EnableEvents = False
    metin = Target.Validation.Formula1
    metin = Right(metin, Len(metin) - 1)
    With TempCombo
      .Visible = True
      .Left = Target.Left
      .Top = Target.Top
      .Width = Target.Width + 15
      .Height = Target.Height + 5
      .ListFillRange = metin
      .LinkedCell = Target.Address
    End With
    TempCombo.Activate
  End If
  
Hata_tutucu:
  Application.EnableEvents = True
  Exit Sub

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim metin As String
Dim TempCombo As OLEObject
Dim sayfa As Worksheet
Set sayfa = ActiveSheet
Application.EnableEvents = False
Application.ScreenUpdating = False

If Application.CutCopyMode Then
  'Sayfa uzerinde kopyala yapistir yapabilmek icin
  GoTo Hata_tutucu
End If

Set TempCombo = sayfa.OLEObjects("TempCombo")
  On Error Resume Next
  With TempCombo
    .Top = 10
    .Left = 10
    .Width = 0
    .ListFillRange = ""
    .LinkedCell = ""
    .Visible = False
    .Value = ""
  End With

Hata_tutucu:
  Application.ScreenUpdating = True
  Application.EnableEvents = True
  Exit Sub

End Sub

Veri Dogrulama Listesini Combobox’a Cevirme

Yazar: mmustafaaslan

2004 yilindan itibaren ozel bir sirketin finans departmaninda calismaktadir. Kendini excel, visual basic kullaniminda gelistirmis olan yazarimiz; Meslegi geregi SAP konusunda ileri derecede bilgilidir.

“Veri Dogrulama Listesini Combobox’a Cevirme” için 6 yorum

  1. Mustafa Bey, bu çalışmadan çok yararlandım. İlginiz için teşekkür ediyorum. Elinize sağlık…

      1. Merhaba, yukarıdaki kod ile çalışmayı tamamladık diye düşünüyordum. Hatırlayacağınız üzere bu çalışmada;

        D sütununda bir hücrede onay verildiğinde hemen yanındaki C sütunundaki açılır menü içeren (listbox/textbox) bu onayla ilgili başka hücrenin kilitlenmesini sağlamak için bir kod uyguladık. Bu kodla dosya iyi çalıştı.

        Fakat açılır menü içinde kişileri araraken uzun liste içinde aramayı kolaylaştırmak için autocomplete özelliğini uygulamak mümkün mü diye araştırdık. Sizin katkınızla listbox için autocomplete özelliği uygulanmaz uyarısıyla, listbox’u autocomplete özelliğini destekleyen comboboxa dönüştürmek için yeni bir kod ekledik. Ancak bu kod ilk kodla birleştirilince ilk kod çalışmaz yani hücre kilitlenmez oldu. Nasıl düzeltebileceğimi ise bulamadım. Yardımcı olur musunuz?

        (Uygulanan Kodlar aşağıda ve istenirse birinci durum ve ikinci durumu gösteren iki dosyayı iletebilirim.)

        Teşekkürler

        1. dosyadaki kod şöyle:

        Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        If Intersect(Target, [c8:g100]) Is Nothing Then Exit Sub
        ActiveSheet.Unprotect
        Range(“c8:g100”).Locked = False
        For sat = 8 To 100
        If Cells(sat, “d”) = “TEYID ALINDI” Then
        Range(Cells(sat, “c”), Cells(sat, “d”)).Locked = True
        Else
        Range(Cells(sat, “c”), Cells(sat, “d”)).Locked = False
        End If
        If Cells(sat, “f”) = “TEYID ALINDI” Then
        Range(Cells(sat, “e”), Cells(sat, “f”)).Locked = True
        Else
        Range(Cells(sat, “e”), Cells(sat, “f”)).Locked = False
        End If
        Next
        ActiveSheet.Protect
        End Sub

        1. kod ile birleştirilen 2. kod ise şöyle:

        Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        If Intersect(Target, [c8:g100]) Is Nothing Then
        ActiveSheet.Unprotect
        Else
        ActiveSheet.Unprotect
        Range(“c8:g100”).Locked = False
        For sat = 8 To 100
        If Cells(sat, “d”) = “TEYID ALINDI” Then
        Range(Cells(sat, “c”), Cells(sat, “d”)).Locked = True
        Else
        Range(Cells(sat, “c”), Cells(sat, “d”)).Locked = False
        End If
        If Cells(sat, “f”) = “TEYID ALINDI” Then
        Range(Cells(sat, “e”), Cells(sat, “f”)).Locked = True
        Else
        Range(Cells(sat, “e”), Cells(sat, “f”)).Locked = False
        End If
        Next
        Call sel_change
        ‘ActiveSheet.Protect
        End If

        End Sub

        Private Sub TempCombo_KeyDown(ByVal _
        KeyCode As MSForms.ReturnInteger, _
        ByVal Shift As Integer)
        ‘Combobox’i sakla, enter,tab ile cik
        Select Case KeyCode
        Case 9
        ActiveCell.Offset(0, 1).Activate
        Case 13
        ActiveCell.Offset(1, 0).Activate
        Case Else
        ‘bos
        End Select

        End Sub

        Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
        Dim metin As String
        Dim Tempcombo As OLEObject
        Dim sayfa As Worksheet
        Dim sayfaListesi As Worksheet
        Set sayfa = ActiveSheet
        Set sayfaListesi = Sheets(“PERSONEL”)
        Cancel = True
        Set Tempcombo = sayfa.OLEObjects(“TempCombo”)
        On Error Resume Next
        With Tempcombo
        .ListFillRange = “”
        .LinkedCell = “”
        .Visible = False
        End With
        On Error GoTo Hata_tutucu
        If Target.Validation.Type = 3 Then
        Application.EnableEvents = False
        metin = Target.Validation.Formula1
        metin = Right(metin, Len(metin) – 1)
        With Tempcombo
        .Visible = True
        .Left = Target.Left
        .Top = Target.Top
        .Width = Target.Width + 15
        .Height = Target.Height + 5
        .ListFillRange = metin
        .LinkedCell = Target.Address
        End With
        Tempcombo.Activate
        End If

        Hata_tutucu:
        Application.EnableEvents = True
        Exit Sub

        End Sub

        Sub sel_change()
        Dim metin As String
        Dim Tempcombo As OLEObject
        Dim sayfa As Worksheet
        Set sayfa = ActiveSheet
        Application.EnableEvents = False
        Application.ScreenUpdating = False

        If Application.CutCopyMode Then
        ‘Sayfa uzerinde kopyala yapistir yapabilmek icin
        GoTo Hata_tutucu
        End If

        Set Tempcombo = sayfa.OLEObjects(“TempCombo”)
        On Error Resume Next
        With Tempcombo
        .Top = 10
        .Left = 10
        .Width = 0
        .ListFillRange = “”
        .LinkedCell = “”
        .Visible = False
        .Value = “”
        End With

        Hata_tutucu:
        Application.ScreenUpdating = True
        Application.EnableEvents = True
        Exit Sub

        End Sub

  2. örnek dosyada veri sayfasında 7 veri için işlem yapıyor. daha fazla verinin olabilmesi için VB de ne değişiklik yapacağımı bulamadım. acemiyim kusura bakmayın. yardımcı olursanız sevinirim.

Bir Cevap Yazın

E-posta hesabınız yayımlanmayacak. Gerekli alanlar * ile işaretlenmişlerdir


7 + 8 =