Listbox'taki İsimleri Sırasıyla Sayfaya Yazdırma

[ahmedummu]

Merhaba arkadaşlar.

Ekte gönderdiğim dosyada Textbox1'e ilgili ayın başlangıç tarihini, Textbox2'ye bitiş tarihini girip butona tıklandığında Nİ sayfasına A4 den başlayarak sırasıyla bitiş tarihine kadar yazıyor. B sütununa Ay ve yıl yazıyor. C sütununa Gün isimlerini yazıyor. Cumartesi ve pazar günlerine gelen satırlardaki tarihleri siliyor. Yani cumartesi pazar günlerine gelen satırlar boş kalıyor.

D sütununu da Listbox1 deki isimleri sırasıyla yazdırmak istiyorum. Cumartesi pazarlara yazılmayacak pazartesi günü hangi isimde kalmışsa o isimden devam edecek.

Bir de Textbox1 ve Textbox2 ye girilen tarihler girilmeyip, combobox1 den ay ismi seçilse Mesela Ekim ayı seçilse text1 ve tex2 ye başlangıç ve bitiş tarihi girilmiş gibi Ekim ayının ilk günü ve son gününe kadar tarihleri yazdırabili miyiz.

 

[askm]

Private Sub CommandButton1_Click()
Dim ilk As Date, son As Date, i As Date
'Sheets("Nİ").Select
If TextBox1.Value = "" And TextBox2.Value = "" Then
MsgBox ("Başlangıç ve bitiş tarihlerini giriniz."), vbCritical, "Uyarı"
Exit Sub
End If
 'Cells(sat, "a").Borders.LineStyle = xlNone
Range("A:D").ClearContents
ilk = Format(TextBox1.Value, "dd.mm.yyyy")
son = Format(TextBox2.Value, "dd.mm.yyyy")
sat = 4
Application.ScreenUpdating = False
On Error Resume Next
For i = ilk To son
    Cells(sat, "a").Value = i
    Cells(sat, "b").Value = Format(i, "mmmm") & "-" & 2017
    Cells(sat, "C").Value = Format(i, "dddd")
    If Cells(sat, "c").Value <> "Cumartesi" And Cells(sat, "c").Value <> "Pazar" Then
        Cells(sat, "D").Value = ListBox1.List(x, 1)
        If x = ListBox1.ListCount - 1 Then
            x = 0
        Else
            x = x + 1
        End If
    End If
        
    For sut = 1 To 4
    Cells(sat, sut).Borders.LineStyle = 1
    Next sut
    sat = sat + 1
Next i


For d = 3 To Range("c65000").End(xlUp).Row
If Cells(d, "c").Value = "Cumartesi" Or Cells(d, "c").Value = "Pazar" Then
For c = 1 To 4
Cells(d, c).Value = ""
'Cells(d, c).BackColor = &HE0E0E0
Next c
End If
Next d



Application.ScreenUpdating = True

 End Sub

 

[ahmedummu]

Sayın askm çok çok teşekkür ederim.

 

[askm]

Rica ederim.

 

[ahmedummu]

Sayın askm rica etsem Cumartesi ve Pazar günlerinin zemin rengini gri yapabilir miyiz.

Bir de Mesela Ekim ayının son günü yani 31 ekimde kimde kaldıysa, bir sonraki ayın çizelgesini hazırlarken, 31 ekimde kalan kişiden sonraki kişiden başlayabilir mi?

 

[askm]

Private Sub CommandButton1_Click()
Dim ilk As Date, son As Date, i As Date
'Sheets("Nİ").Select
If TextBox1.Value = "" And TextBox2.Value = "" Then
MsgBox ("Başlangıç ve bitiş tarihlerini giriniz."), vbCritical, "Uyarı"
Exit Sub
End If
 'Cells(sat, "a").Borders.LineStyle = xlNone
Range("A:D").ClearContents
ilk = Format(TextBox1.Value, "dd.mm.yyyy")
son = Format(TextBox2.Value, "dd.mm.yyyy")
sat = 4
Application.ScreenUpdating = False
On Error Resume Next
For i = ilk To son
    Cells(sat, "a").Value = i
    Cells(sat, "b").Value = Format(i, "mmmm") & "-" & 2017
    Cells(sat, "C").Value = Format(i, "dddd")
    If Cells(sat, "c").Value <> "Cumartesi" And Cells(sat, "c").Value <> "Pazar" Then
        Cells(sat, "D").Value = ListBox1.List(x, 1)
        If x = ListBox1.ListCount - 1 Then
            x = 0
        Else
            x = x + 1
        End If
    Else
        Range(Cells(sat, "A"), Cells(sat, "D")).Interior.ColorIndex = 16
    End If
        
    For sut = 1 To 4
    Cells(sat, sut).Borders.LineStyle = 1
    Next sut
    sat = sat + 1
Next i


For d = 3 To Range("c65000").End(xlUp).Row
If Cells(d, "c").Value = "Cumartesi" Or Cells(d, "c").Value = "Pazar" Then
For c = 1 To 4
Cells(d, c).Value = ""
'Cells(d, c).BackColor = &HE0E0E0
Next c
End If
Next d
Application.ScreenUpdating = True
End Sub

 

[ahmedummu]

Elinize sağlık sayın askm.

Birşey daha isteyebilir miyim. Formun üzerine bir adet combo eklesem (Combobox1) Combodan Ekim ayı seçilse Text1'e Ekimin ilk gün tarihi yani 01.10.2017, text2'ye de ekim ayının son günü yani 31.10.2017 tarihini yazdırabilir miyiz. Combodan seçilen aylar için bu işlemler yapılacak.

 

[askm]

Private Sub ComboBox1_Change()
Dim Ay As String
Dim AyS As Integer
Ay = UserForm1.ComboBox1.Text
Select Case Ay
    Case "Ocak"
        AyS = 1
    Case "Şubat"
        AyS = 2
    Case "Mart"
        AyS = 3
    Case "Nisan"
        AyS = 4
    Case "Mayıs"
        AyS = 5
    Case "Haziran"
        AyS = 6
    Case "Temmuz"
        AyS = 7
    Case "Ağustos"
        AyS = 8
    Case "Eylül"
        AyS = 9
    Case "Ekim"
        AyS = 10
    Case "Kasım"
        AyS = 11
    Case "Aralık"
        AyS = 12
End Select
tarih = DateSerial(Year(Date), AyS, 1)
Song = Format(WorksheetFunction.EoMonth(tarih, 0), "dd.mm.yyyy")
Ilkg = Format(WorksheetFunction.EoMonth(tarih, -1) + 1, "dd.mm.yyyy")
TextBox1.Text = Format(Ilkg, "dd.mm.yyyy")
TextBox2.Text = Format(Song, "dd.mm.yyyy")
End Sub

 

[ahmedummu]

Sayın askm İlginize teşekkür ederim. SAğolun.

Hangi ayı seçersem seçeyim.

Textbox1 01.12.2016
Textbox2 31.12.2016

Sonucunu veriyor

 

[askm]

Dilerseniz bu çalışmanızı askmadige34@hotmail.com adresine mail atın. Çalışır halde tekrar mail atayım. Benim yaptığım dosyada çalışıyor.

 

[ahmedummu]

Sayın askm dosyayı belirtilen mail adresine gönderdim.

Bir de userform18 de bulunan combo1'in değeri MİF sayfasına yazdırdığımda 47 olarak çıkıyor. Halbuki Combo1'in değeri bir isim. İsmi veritabanından comboya alırken 2 sütun halinde alınmış ilk sütun ID numarası 2. sütun isim. MİF sayfasına yazdırırken 1. sütunu yani ID nurarasını yazıyor. Ona da bakarsanız sevinirim. Teşekkürler.

 

[askm]

Mail ile cevap verilmiştir.

 

[ahmedummu]

Sayın askm çok teşekkür ederim.