• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Listbox ile bicimlendirilen hücreleri secmek

Katılım
4 Haziran 2013
Mesajlar
23
Excel Vers. ve Dili
2010 almanca
Mehabalar Arkadaslar...

Icinden bir türlü cikamadigim bana göre büyük tabi ki sizlere göre kücük bir sorunum var. Bana bu konuda yardimci olursaniz cok sevinecegim.

Soruma gelecek olursak; ekteki dosyadan da anlasilacagi üzere Dosyamin icinde bulunan A ve B sayfasi yer almaktadir. Benim amacim A-Sayfasi icinde olusturdugum üc farkli renkteki bos olan hücrelerin B-sayfasinda olusturdugum Listbox ile secebilmek yani sadece bicimleri... Umarim kendimi iyi ifade edebilmisimdir.

Yardimci olacak olan arkadaslarima simdiden cok tesekkür ederim.
 

Ekli dosyalar

Listbox içinde renk kodları yada isimlerini gösterebilirsiniz.
 
Sayin hamitcan,

"Listbox içinde renk kodları yada isimlerini gösterebilirsiniz" demissiniz.
Biraz acarsaniz cok sevinirim.
 
Sayfa içindeki renklerin isimlerini Listbox içine alabilirsiniz. Örn: Yeşil gibi yada ilgili rengin kodu.
 
Sayin hamitcan,

Öncelikle ilginiz ve sabriniz icin cok tesekkür ederim. Fakat ben, sayfa icindeki renkleri nasil Listbox icine alabilecegimi, hala anlamis degilim. Örnek bir dosya göndermis idim, eger o dosya üzerinde gösterip yardimci olabilir iseniz cok sevinirim.

tesekkürler....
 
Kodu, B-Sayfasi kod kısmına ekleyin.
Kod:
Private Sub ListBox1_Click()
    ActiveCell.Interior.ColorIndex = ListBox1.List(ListBox1.ListIndex, 1)
End Sub

Private Sub Worksheet_Activate()
    ListBox1.Clear
    For i = 1 To Sheets("A-Sayfasi").UsedRange.Count
        If CellColor(Sheets("A-Sayfasi").Cells(i, 1), True) <> "Custom color or no fill" Then
             ListBox1.AddItem
             ListBox1.List(i - 1, 0) = CellColor(Sheets("A-Sayfasi").Cells(i, 1), True)
             ListBox1.List(i - 1, 1) = CellColor(Sheets("A-Sayfasi").Cells(i, 1), False)
        End If
    Next
End Sub
Bir Module içine aşağıdaki fonksiyonu ekleyin. Fonksiyın içindeki isimle İngilizce'dir bu yüzden değiştirmek size kalıyor.
Kaynak: http://www.ozgrid.com/VBA/ReturnCellColor.htm

Kod:
Function CellColor(rCell As Range, Optional ColorName As Boolean)
Dim strColor As String, iIndexNum As Integer
'Written by Dave Hawley of OzGrid.com
Select Case rCell.Interior.ColorIndex
   Case 1
    strColor = "Black"
    iIndexNum = 1
   Case 53
    strColor = "Brown"
    iIndexNum = 53
   Case 52
    strColor = "Olive Green"
    iIndexNum = 52
   Case 51
    strColor = "Dark Green"
    iIndexNum = 51
   Case 49
    strColor = "Dark Teal"
    iIndexNum = 49
   Case 11
    strColor = "Dark Blue"
    iIndexNum = 11
   Case 55
    strColor = "Indigo"
    iIndexNum = 55
   Case 56
    strColor = "Gray-80%"
    iIndexNum = 56
   Case 9
    strColor = "Dark Red"
    iIndexNum = 9
   Case 46
    strColor = "Orange"
    iIndexNum = 46
   Case 12
    strColor = "Dark Yellow"
    iIndexNum = 12
   Case 10
    strColor = "Green"
    iIndexNum = 10
   Case 14
    strColor = "Teal"
    iIndexNum = 14
   Case 5
    strColor = "Blue"
    iIndexNum = 5
   Case 47
    strColor = "Blue-Gray"
    iIndexNum = 47
   Case 16
    strColor = "Gray-50%"
    iIndexNum = 16
   Case 3
    strColor = "Red"
    iIndexNum = 3
   Case 45
    strColor = "Light Orange"
    iIndexNum = 45
   Case 43
    strColor = "Lime"
    iIndexNum = 43
   Case 50
    strColor = "Sea Green"
    iIndexNum = 50
   Case 42
    strColor = "Aqua"
    iIndexNum = 42
   Case 41
    strColor = "Light Blue"
    iIndexNum = 41
   Case 13
    strColor = "Violet"
    iIndexNum = 13
   Case 48
    strColor = "Gray-40%"
    iIndexNum = 48
   Case 7
    strColor = "Pink"
    iIndexNum = 7
   Case 44
    strColor = "Gold"
    iIndexNum = 44
   Case 6
    strColor = "Yellow"
    iIndexNum = 6
   Case 4
    strColor = "Bright Green"
    iIndexNum = 4
   Case 8
    strColor = "Turqoise"
    iIndexNum = 8
   Case 33
    strColor = "Sky Blue"
    iIndexNum = 33
   Case 54
    strColor = "Plum"
    iIndexNum = 54
   Case 15
    strColor = "Gray-25%"
    iIndexNum = 15
   Case 38
    strColor = "Rose"
    iIndexNum = 38
   Case 40
    strColor = "Tan"
    iIndexNum = 40
   Case 36
    strColor = "Light Yellow"
    iIndexNum = 36
   Case 35
    strColor = "Light Green"
    iIndexNum = 35
   Case 34
    strColor = "Light Turqoise"
    iIndexNum = 34
   Case 37
    strColor = "Pale Blue"
    iIndexNum = 37
   Case 39
    strColor = "Lavendar"
    iIndexNum = 39
   Case 2
    strColor = "White"
    iIndexNum = 2
  Case Else
    strColor = "Custom color or no fill"
End Select
    If ColorName = True Or _
        strColor = "Custom color or no fill" Then
        CellColor = strColor
    Else
        CellColor = iIndexNum
    End If
End Function
 

Ekli dosyalar

Sayin hamitcan,

vermis oldugunuz örnek dosyaya baktim, kafamda daha farkli birsey olmasina ragmen bu vermis oldugunuz örnek aslinda cok daha iyi kullanabilecegim bir sablon olmus. Ben VBA hic bilmememe ragmen biraz kurcalayarak Listbox'u Combo-box'a cevirdim. Yalniz rekleri nasil kendim olusturabilirim? Nasil ekleyebilirim? Vermis oldugunuz kod ta nasil degisiklik yapmam gerekir? Ben yardimlariniz icin cok tesekkur ederim.
 
ComboBox ile de bir örnek yaptım. Eki inceleyin.
 

Ekli dosyalar

Cok tesekkür ederim. Emeginize saglik.
 
Geri
Üst