listboxta rapor alma

[peleryn]

Herkese merhabalar;

Ekteki dosyada öğrenci seanslarını dağıttığımız çizelgenin basitleştirilmiş bir örneği var.Birinci userformda çizelge içine yerleşen öğrencilerin isimlerini listeleyen bir listbox var ve bir öğrenci ismine tıkladığımızda sayfa içerisinde bu öğrencinin yazılı olduğu hücreleri renklendiriyor.
Buraya kadar buradaki hocalarımın yardımı ile gayet güzel bir dosya yaptık.Hepsine tekrar teşekkür ediyorum.

Şimdi ben bu dosyaya üzerinde bir listbox daha olan bir userform daha ekledim.Bu listboxta seçili olan öğrencinin hangi hoca,tarih,gün ve saatlerde yazılı olduğunun listelenmesi gerekiyor fakat ne yapsam içinden çıkamıyorum.Yardımcı olan olursa çok sevinirim.

Daha detaylı açıklama dosyanın içindedir.

İlgilenen herkese şimdiden teşekkür ederim.

 

[halit3]

Herkese merhabalar;

Ekteki dosyada öğrenci seanslarını dağıttığımız çizelgenin basitleştirilmiş bir örneği var.Birinci userformda çizelge içine yerleşen öğrencilerin isimlerini listeleyen bir listbox var ve bir öğrenci ismine tıkladığımızda sayfa içerisinde bu öğrencinin yazılı olduğu hücreleri renklendiriyor.
Buraya kadar buradaki hocalarımın yardımı ile gayet güzel bir dosya yaptık.Hepsine tekrar teşekkür ediyorum.

Şimdi ben bu dosyaya üzerinde bir listbox daha olan bir userform daha ekledim.Bu listboxta seçili olan öğrencinin hangi hoca,tarih,gün ve saatlerde yazılı olduğunun listelenmesi gerekiyor fakat ne yapsam içinden çıkamıyorum.Yardımcı olan olursa çok sevinirim.

Daha detaylı açıklama dosyanın içindedir.

İlgilenen herkese şimdiden teşekkür ederim.

ekli dosyaya bir bakarmısınız.

dosya aşağıdaki mesajda

 

[peleryn]

Halit hocam;

Çok kısa bir zamanda çok güzel bir çözüm sundunuz ellerinize sağlık çok teşekkür ederim.Eğer zaman ayırabilirseniz ve uğraşmaya değer görürseniz bir sorum daha olacak.

Listbox'ta listelenen satırlardan birine bir kez tıkladığımda;o satırda bilgileri listelenmiş olan öğrencinin isminin bulunduğu hücre aktif olurken userform'um da bu satır görülebilecek ve işlem yapılabilecek şekilde konum değiştirebilir mi (bir nevi sayfada yüzer gibi)?

 

[halit3]

Halit hocam;

Çok kısa bir zamanda çok güzel bir çözüm sundunuz ellerinize sağlık çok teşekkür ederim.Eğer zaman ayırabilirseniz ve uğraşmaya değer görürseniz bir sorum daha olacak.

Listbox'ta listelenen satırlardan birine bir kez tıkladığımda;o satırda bilgileri listelenmiş olan öğrencinin isminin bulunduğu hücre aktif olurken userform'um da bu satır görülebilecek ve işlem yapılabilecek şekilde konum değiştirebilir mi (bir nevi sayfada yüzer gibi)?

yaklaşık olarak geliyor ekli dosyanızı kontrol ediniz.

dosya aşağıdaki mesajda

 

[peleryn]

Halit hocam;

Bir günde dosyamın akışını inanılmaz ölçüde değiştirdiniz.Son değişikliklerle tam istediğim gibi oldu.Seçili satırın renklendirilmesi de ayr bir kolaylık katmış ellerinize sağlık çok teşekkür ediyorum.İyi ve zevkli çalışmalar dilerim..

 

[halit3]

rica ederim iyi çalışmalar

 

[peleryn]

Halit Hocam ;
------------------------------------------------
Const iInternational As Integer = Not (0)
------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim iColor As Integer
On Error Resume Next
iColor = Target.Interior.ColorIndex
If iColor < 0 Then
iColor = 28
Else
iColor = iColor + 1
End If
If iColor = Target.Font.ColorIndex Then iColor = iColor + 1
Cells.FormatConditions.Delete
With Range("D" & Target.Row, "L" & Target.Row)
.FormatConditions.Add Type:=2, Formula1:=iInternational
.FormatConditions(1).Interior.ColorIndex = iColor
End With
With Range(Target.Offset(1 - Target.Row, 0).Address & ":" & Target.Offset(-1, 0).Address)
.FormatConditions.Add Type:=2, Formula1:=iInternational

End With
End Sub
--------------------------------------------------------------

kodlarının çalıştığı sayfada kopyala/yapıştır işlemini kullanamıyorum.Aksi gibi o kadar hoş bir makro yazmışsınız ki başka dosyalarımda da kullanmak istiyorum.
Sizce bu sorunun çözülebilmesi mümkün müdür?

 

[halit3]

Halit Hocam ;
------------------------------------------------
Const iInternational As Integer = Not (0)
------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim iColor As Integer
On Error Resume Next
iColor = Target.Interior.ColorIndex
If iColor < 0 Then
iColor = 28
Else
iColor = iColor + 1
End If
If iColor = Target.Font.ColorIndex Then iColor = iColor + 1
Cells.FormatConditions.Delete
With Range("D" & Target.Row, "L" & Target.Row)
.FormatConditions.Add Type:=2, Formula1:=iInternational
.FormatConditions(1).Interior.ColorIndex = iColor
End With
With Range(Target.Offset(1 - Target.Row, 0).Address & ":" & Target.Offset(-1, 0).Address)
.FormatConditions.Add Type:=2, Formula1:=iInternational

End With
End Sub
--------------------------------------------------------------

kodlarının çalıştığı sayfada kopyala/yapıştır işlemini kullanamıyorum.Aksi gibi o kadar hoş bir makro yazmışsınız ki başka dosyalarımda da kullanmak istiyorum.
Sizce bu sorunun çözülebilmesi mümkün müdür?

tamam o zaman şöyle yapın A1 hücresi boşsa bu makro çalışacak eğer dolu ise bu makro çalışmayacak

Const iInternational As Integer = Not (0)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Cells(1, 1).Value = "" Then
Dim iColor As Integer
On Error Resume Next
iColor = Target.Interior.ColorIndex
If iColor < 0 Then
iColor = 28
Else
iColor = iColor + 1
End If
If iColor = Target.Font.ColorIndex Then iColor = iColor + 1
Cells.FormatConditions.Delete
With Range("C" & Target.Row, "M" & Target.Row)
.FormatConditions.Add Type:=2, Formula1:=iInternational
.FormatConditions(1).Interior.ColorIndex = iColor
End With
With Range(Target.Offset(1 - Target.Row, 0).Address & ":" & Target.Offset(-1, 0).Address)
.FormatConditions.Add Type:=2, Formula1:=iInternational
End With
Else
On Error Resume Next
iColor = Target.Interior.ColorIndex
If iColor < 0 Then
iColor = 28
Else
iColor = iColor + 1
End If
If iColor = Target.Font.ColorIndex Then iColor = iColor + 1
Cells.FormatConditions.Delete
End If
End Sub

 

[peleryn]

Sağolun hocam biraz aç gözlülük ettim ikisi bir olsun hem kopyala yapıştır yapsın hem satırı renklendirsin istedim ama böyle de gayet güzel tekrar ellerinize sağlık.Çok teşekkür ederim.

 

[halit3]

Sağolun hocam biraz aç gözlülük ettim ikisi bir olsun hem kopyala yapıştır yapsın hem satırı renklendirsin istedim ama böyle de gayet güzel tekrar ellerinize sağlık.Çok teşekkür ederim.

tamam ozaman bunu denermisin

Const iInternational As Integer = Not (0)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Application.CutCopyMode = False Then
Dim iColor As Integer
On Error Resume Next
iColor = Target.Interior.ColorIndex
If iColor < 0 Then
iColor = 28
Else
iColor = iColor + 1
End If
If iColor = Target.Font.ColorIndex Then iColor = iColor + 1
Cells.FormatConditions.Delete
With Range("C" & Target.Row, "M" & Target.Row)
.FormatConditions.Add Type:=2, Formula1:=iInternational
.FormatConditions(1).Interior.ColorIndex = iColor
End With
With Range(Target.Offset(1 - Target.Row, 0).Address & ":" & Target.Offset(-1, 0).Address)
.FormatConditions.Add Type:=2, Formula1:=iInternational
End With
Else
On Error Resume Next
iColor = Target.Interior.ColorIndex
If iColor < 0 Then
iColor = 28
Else
iColor = iColor + 1
End If
If iColor = Target.Font.ColorIndex Then iColor = iColor + 1
Cells.FormatConditions.Delete
End If
End Sub

 

[halit3]

yukarıdaki kodu yeniden düzenledim

 

[peleryn]

Sayfaya bir checkbox koyup false durumuna kodunuzu atadım gayet hoş oldu.İlgi ve emekleriniz için teşekkürler Halit hocam.

 

[halit3]

Sayfaya bir checkbox koyup false durumuna kodunuzu atadım gayet hoş oldu.İlgi ve emekleriniz için teşekkürler Halit hocam.

iyi günler

 

[halit3]

dosyanın son halini gönderiyorum

dosya aşağıdaki mesajda

 

[peleryn]

Hocam çok güzel oldu elinize sağlık.Checkbox ı siz değişiklik yapmadan önce eklemiştim.Şimdi sizin verdiğiniz son haliyle kullanacağım.İyi çalışmalar dilerim.

 

[peleryn]

Mükerrer Kayıt

Halit Hocam;

Son yolladığınız dosyada son bir ihtiyacımı daha belirtmek üzere ufak bir düzenleme yaptım ve bir açıklama ekledim.Seanslar dağıtılırken aynı gün ve saatte yani aynı satırda bir ismin birden fazla kere geçmemesi gerekiyor.Ama mükerrer kayıdı önlemek değil rapor adlı userformumun açılışında mükerrer kayıt varsa uyarı almak istiyorum.Sizi yormamak için sitede mükerrerle ilgili dosyaları incelemeye çalıştım ama yine işin içinden çıkamadım.Yardımcı olursanız çok sevinirim.
Dosya ektedir.

 

[halit3]

Halit Hocam;

Son yolladığınız dosyada son bir ihtiyacımı daha belirtmek üzere ufak bir düzenleme yaptım ve bir açıklama ekledim.Seanslar dağıtılırken aynı gün ve saatte yani aynı satırda bir ismin birden fazla kere geçmemesi gerekiyor.Ama mükerrer kayıdı önlemek değil rapor adlı userformumun açılışında mükerrer kayıt varsa uyarı almak istiyorum.Sizi yormamak için sitede mükerrerle ilgili dosyaları incelemeye çalıştım ama yine işin içinden çıkamadım.Yardımcı olursanız çok sevinirim.
Dosya ektedir.

ekli dosyaya bir bakınız

 

[peleryn]

Hocam yine ellerinize sağlık..
Yanıtınızı sabah aldım işyerinde hemen dosyaya tatbik ettim ve sonuç harika hocam.Hızlı ilgi ve desteğiniz için ayrıca teşekkür ederim.İyi çalışmalar dilerim.