Soru vba da tarih hesaplama?

[s.savas]

Merhaba arkadaşlar.
Textbox4 de işin bitim tarihi bilgisi var. Örnek: 31.12.2020
Her hangi bir label veya textboxta bu tarihin 3 ay öncesini hesaplatmak istiyorum.

 

[ÖmerBey]

Merhaba,
Şu şekilde ilgili değere ulaşabilirsiniz...

Format(WorksheetFunction.EDate(DateValue(TextBox4.Text), -3), "dd.mm.yyyy")

 

[s.savas]

Merhaba,
Şu şekilde ilgili değere ulaşabilirsiniz...

Format(WorksheetFunction.EDate(DateValue(TextBox4.Text), -3), "dd.mm.yyyy")

Teşekkür ederim üstat, kod sorunsuz çalıştı.
Müsadeniz olursa yeni bir konu açmadan aynı kodun işlevsel olarak devamı niteliğinde bir soru daha sormak isterim.
Textbox4 te tanımlanan tarihten 3 ay öncesine ait tarihin listview1'in 26. kolonuna yüklendiğini farz edelim.
Örnek üzerinden yürürsek; işin bitim tarihi 31.12.2020 ise üç ay öncesi 30.09.2020 oluyor. 30.09.2020 tarihinden başlayarak 31.12.2020 tarihine kadar renklenmesini veya uyarı vermesini nasıl sağlarız.?
Normalde aşağıdaki kod şartı sağlayan verileri kırmızı renge boyuyor. Bu kod revize edilerek istenen sonuç elde edilebilirmi?

Sub filtre()
On Error Resume Next
For i = 1 To ListView1.ListItems.Count
If ListView1.ListItems(i).SubItems(26) = "AÇIKTA" Then
For A = 1 To ListView1.ColumnHeaders.Count
ListView1.ListItems(i).ListSubItems(A).ForeColor = vbRed
ListView1.ListItems(i).ListSubItems(A).Bold = True
Next A
End If
Next i
End Sub

 

[ÖmerBey]

Farazi konuşmak ne derece doğru olur bilemem ama kodunuzdaki if sorgusunu şu şekilde tasarlayabilirsiniz sanıyorum...

If ListView1.ListItems(i).SubItems(26) >= DateValue("30.09.2020") And ListView1.ListItems(i).SubItems(26) <= DateValue("31.12.2020") Then

 

[s.savas]

Farazi konuşmak ne derece doğru olur bilemem ama kodunuzdaki if sorgusunu şu şekilde tasarlayabilirsiniz sanıyorum...

If ListView1.ListItems(i).SubItems(26) >= DateValue("30.09.2020") And ListView1.ListItems(i).SubItems(26) <= DateValue("31.12.2020") Then

Teşekkür ederim üstat.
Yukarıdaki kod; listview1 7. kolonda bulunan tarihi (işin bitiş tarihi) sistem tarihinden çıkaracak, aradaki fark 3 ay olduğu zaman renklenmeye başlayacak, her iki tarih eşitlenince renklendirme sonlanacak şekilde düzenlenebilirmi?

 

[ÖmerBey]

Merhaba,
Aşağıdaki kodu Userform1 içerisine kopyalayıp listview güncellemesi yaptığınız kodların altına renklendir yazarak kodu çağırınız.

Private Sub renklendir()
Dim a As Integer, trh As Date
For a = 1 To Me.ListView1.ListItems.Count
    trh = Me.ListView1.ListItems(a).ListSubItems(7)
    If Date >= WorksheetFunction.EDate(trh, -3) And Date <= trh Then
        Me.ListView1.ListItems(a).ListSubItems(7).ForeColor = vbRed
    End If
Next
Me.ListView1.Refresh
End Sub

 

[s.savas]

Merhaba,
Aşağıdaki kodu Userform1 içerisine kopyalayıp listview güncellemesi yaptığınız kodların altına renklendir yazarak kodu çağırınız.

Private Sub renklendir()
Dim a As Integer, trh As Date
For a = 1 To Me.ListView1.ListItems.Count
    trh = Me.ListView1.ListItems(a).ListSubItems(7)
    If Date >= WorksheetFunction.EDate(trh, -3) And Date <= trh Then
        Me.ListView1.ListItems(a).ListSubItems(7).ForeColor = vbRed
    End If
Next
Me.ListView1.Refresh
End Sub

Teşekkür ederim üstat. Kod çalışıyor.
Yalnız sadece 7.kolonu değilde koşulu sağlayan diğer kolonlarda renklense daha şık olacak.

 

[ÖmerBey]

Yukarıdaki koddaki Me.ListView1.ListItems(a).ListSubItems(7).ForeColor = vbRed satırındaki 7 rakamını her bir sütun için değiştirerek kodu uyarlayabilirsiniz. Ya da döngü ile yapmak isterseniz bu satırı aşağıdaki ile değiştiriniz.

For Each hcr In Me.ListView1.ListItems(a).ListSubItems
    hcr.ForeColor = vbRed
Next

İyi çalışmalar...