listview renklendirme

theglacier · 8 Şubat 2016

Selamlar,

listviewde textboxa sürüklediğim satırı renklendirmek istiyorum, ama refresh yaptığım zaman textboxa attıklarım listviewde renkli olmadan duruyor. renkli olmadığı için, hangi satırı textboxa attığımı görmekte zorlanıyorum.
aşağıdaki şekilde kodu yazdım, ama pek işe yaramadı. nerede hata yaptığıma dair debug uyarısıda gelmiyor. listview güncellendiğinde textboxa sürüklenen satırları kırmızı renkle işaretlemesini nasıl yapabilirim acaba?
yardımlarınız için şimdiden teşekkürler.

Sub color ()

Dim n As String
n = UserForm1.ListView1.ListItems.Count
Dim i As Long
For i = 1 To n

If UserForm1.ListView1.ListItems(i).ListSubItems(5) = 1 Then

UserForm1.ListView1.ListItems(i).ForeColor = vbRed
UserForm1.ListView1.ListItems(i).Bold = True
UserForm1.ListView1.ListItems(i).ListSubItems(1).ForeColor = vbRed
UserForm1.ListView1.ListItems(i).ListSubItems(1).Bold = True
UserForm1.ListView1.ListItems(i).ListSubItems(2).ForeColor = vbRed
UserForm1.ListView1.ListItems(i).ListSubItems(2).Bold = True
UserForm1.ListView1.ListItems(i).ListSubItems(3).ForeColor = vbRed
UserForm1.ListView1.ListItems(i).ListSubItems(3).Bold = True
UserForm1.ListView1.ListItems(i).ListSubItems(4).ForeColor = vbRed
UserForm1.ListView1.ListItems(i).ListSubItems(4).Bold = True
UserForm1.ListView1.ListItems(i).ListSubItems(5).ForeColor = vbRed
UserForm1.ListView1.ListItems(i).ListSubItems(5).Bold = True
End If
Next i

End Sub

sub liste ()

listviewle ilgili satırlar.....

call color

end sub

theglacier · 11 Şubat 2016

selamlar,
fikirlerinize ihtiyacım var yol göstermesi açısından.
yapmaya çalıştığım şey, listviewde kullandığım satırın(textboxa sürüklediklerim), güncellendikten sonra kullanılan satırın kırmızı olarak listview sıralamasında görünmesi. nerede hata yaptığımı çözemedim. bu konuda yardımınızı bekliyorum. yaptığım programda sadece eksik kalan kısım bu. bu şekilde de işlev görür, ama hata yapmaya açık olarak.

Private Sub UserForm_Activate()
On Error Resume Next
Dim n As String
Dim i As Long
n = UserForm1.ListView1.ListItems.Count
For i = 1 To n
If UserForm1.ListView1.ListItems(i).ListSubItems(5) = "1" Then

UserForm1.ListView1.ListItems(i).ForeColor = vbRed
UserForm1.ListView1.ListItems(i).Bold = True
UserForm1.ListView1.ListItems(i).ListSubItems(1).ForeColor = vbRed
UserForm1.ListView1.ListItems(i).ListSubItems(1).Bold = True
UserForm1.ListView1.ListItems(i).ListSubItems(2).ForeColor = vbRed
UserForm1.ListView1.ListItems(i).ListSubItems(2).Bold = True
UserForm1.ListView1.ListItems(i).ListSubItems(3).ForeColor = vbRed
UserForm1.ListView1.ListItems(i).ListSubItems(3).Bold = True
UserForm1.ListView1.ListItems(i).ListSubItems(4).ForeColor = vbRed
UserForm1.ListView1.ListItems(i).ListSubItems(4).Bold = True
UserForm1.ListView1.ListItems(i).ListSubItems(5).ForeColor = vbRed
UserForm1.ListView1.ListItems(i).ListSubItems(5).Bold = True

End If
Next i
Call Listupdate

End Sub

PLİNT · 11 Şubat 2016

Merhaba
Dosyanızın örneğini ekleyip indrime adresini bildirirseniz: http://www.dosya.tc
Textbox a aktaran ve yenileyen kodları görmek gerekir diye düşünüyorum.
Ayrıca Listede satır mı renklenecek; yukarıdaki gibi yazı rengimi?

theglacier · 11 Şubat 2016

dediğiniz gibi, yazı rengi olacak hocam. yanlış söylemişim yukarıda.
dosyayı küçültürsem göndericem.
yorumunuz için teşekkürler.

PLİNT · 11 Şubat 2016

theglacier' Alıntı:
dediğiniz gibi, yazı rengi olacak hocam. yanlış söylemişim yukarıda.
dosyayı küçültürsem göndericem.
yorumunuz için teşekkürler.

Merhaba
Sanırım vakit alacak,ek dosyadaki gibi olurmu?
http://s8.dosya.tc/server/qseien/listview.zip.html

Kod:

Private Sub UserForm_Initialize()
Set sf = Sheets(1)
ListView1.ListItems.Clear: ListView1.ColumnHeaders.Clear
With ListView1
.View = lvwReport: .Gridlines = True: .FullRowSelect = True: .ListItems.Clear
For a = 1 To 5
F = (sf.Columns(a).ColumnWidth - ((sf.Columns(a).ColumnWidth / 10) * 1.5)) * 8 '4.43
.ColumnHeaders.Add , , sf.Cells(1, a) & " ", F
Next
End With
For i = 2 To sf.Cells(Rows.Count, 1).End(xlUp).Row
ListView1.ListItems.Add , , sf.Cells(i, 1).Value
y = ListView1.ListItems.Count
For a = 2 To 5
ListView1.ListItems(y).ListSubItems.Add , , sf.Cells(i, a).Value
Next
Next i

End Sub

Private Sub ListView1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS)
 ListView1.FullRowSelect = True
 ListView1.LabelWrap = False
End Sub

Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
Set sf = Sheets(1)

 With UserForm1.ListView1
 
 '........................AŞAĞIDAKİ BÖLÜM SATIRDAKİ RENKLENENLERİ SİYAH YAPSIN ...............
 
For s = 1 To .ListItems.Count
If ListView1.ListItems(s).ForeColor = vbRed Then
ListView1.ListItems(s).ForeColor = vbBlack
ListView1.ListItems(s).Bold = False
For n = 1 To 4
ListView1.ListItems(s).ListSubItems(n).ForeColor = vbBlack
ListView1.ListItems(s).ListSubItems(n).Bold = False
Next
End If
Next
'......................................................................................

   .SelectedItem.ForeColor = vbRed
   .SelectedItem.Bold = True
For a = 1 To 5
If a < 5 Then
.SelectedItem.ListSubItems(a).ForeColor = vbRed
.SelectedItem.ListSubItems(a).Bold = True
End If
Me.Controls("TextBox" & a).Value = sf.Cells(ListView1.SelectedItem + 1, a).Value
Next
.FullRowSelect = False
End With

End Sub

theglacier · 11 Şubat 2016

hocam vakit ayırıp uğraştığınız için çok teşekkür ederim öncelikle.
ekli dosyanız, tam istediğim gibi değil.
sorunu tam anlatamadım. o yüzden dosyayı gönderiyorum.
http://s6.dosya.tc/server6/uwuk7w/sample.xls.html

dosyada göreceğiniz gibi, üstte listview var. aşağı kısımda textboxlar, listviewdeki sırayı textboxlara sürükleyip bırakıyorum. bıraktıktan sonra güncelle butonuna tıklıyorum. listview listesi güncelleniyor (liste geri yükleniyor). textboxa sürüklenen değerleri, güncelle butonuna tıkladıktan sonra listview sırasında yer alan yazıları kırmızı olarak belirtmek istiyorum. textboxa sürüklenmeyen değerler yine aynı kalacak. yani burada, textboxa hangi değerleri sürüklediklerimi bilmek istiyorum güncelledikten sonra.
ilginiz ve uğraşınız için çok teşekkür ederim. Allah razı olsun.

PLİNT · 12 Şubat 2016

Merhaba
Ek dosyayı deneyiniz:
http://s3.dosya.tc/server8/ny9un4/listview2.zip.html
sizin eklediğiniz dosyada "Listview" bende açılmadı yerine "listview 6.0" eklendi,
yukarıdaki örnek ortaya çıktı; textboxlar 164-170 ; ve listeye alınan "D" adlı sayfadan
"I" sütununa kadar; "j" sütunu yerine sıra no ekleniyor kodlarda bu duruma göredir.
"Sub ListeGuncelle1()" altında hata var; işaretlidir.

Kod:

 Sub color()
On Error Resume Next
Dim n, d As String
Dim i As Long
Dim X, X2, X3, b As Integer
For i = 1 To UserForm1.ListView1.ListItems.Count
d = Empty
d = UserForm1.ListView1.ListItems(i)
For X = 0 To 8
d = d & vbCrLf & UserForm1.ListView1.ListItems(i).ListSubItems(X)
Next
For X2 = 164 To 170 ' TEXTBOX NO LARI;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
If Controls("Textbox" & X2).Text = d Then
X3 = 1
Exit For
End If
Next
If X3 = 1 Then
X3 = 0
UserForm1.ListView1.ListItems(i).ForeColor = vbRed
UserForm1.ListView1.ListItems(i).Bold = True
For b = 1 To 8
UserForm1.ListView1.ListItems(i).ListSubItems(b).ForeColor = vbRed
UserForm1.ListView1.ListItems(i).ListSubItems(b).Bold = True
Next
Else
UserForm1.ListView1.ListItems(i).ForeColor = vbBlack
UserForm1.ListView1.ListItems(i).Bold = False
For b = 1 To 8
UserForm1.ListView1.ListItems(i).ListSubItems(b).ForeColor = vbBlack
UserForm1.ListView1.ListItems(i).ListSubItems(b).Bold = False
Next
End If
Next i
End Sub

theglacier · 12 Şubat 2016

ilgi ve emeğiniz için çok teşekkür ederim. nokta atışı yapmışsınız hocam.
belirttiğiniz hata kısmını gözden geçiricem.
Allah sizden razı olsun. iyi geceler.