Soru Aya göre - Rakamlar ve Günlerin yazımı

[k0081]

Merhaba arkadaşlar;

Aşağıda vermiş olduğum excel dosyasında;

C3 hücresine ; PERSONEL ( AĞUSTOS 2022 ) yazdığımda;

D3:BL3 e kadar kısımda gün isimlerini 8 punto , Rakamları 11 punto olarak istenen sayfada gösterildiği gibi otomatik yazdırabilirmiyiz ?

yardımcı arkadaşa şimdiden Teşekkürler.

LISTE-1.xlsm dosyasını indir - download

LISTE-1.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

www.dosya.tc

 

[Ziynettin]

Deneyiniz...

Sub test()
Application.ScreenUpdating = False
deg = [C3]
x = InStrRev(deg, "(") + 1
y = InStrRev(deg, ")") - x

trh = "1." & VBA.Trim(Mid(deg, x, y))
finis = Day(DateAdd("m", 1, trh) - 1)
[D3].Resize(, 62).ClearContents

say = 1
ReDim b(1 To 1, 1 To finis * 2)
    For i = 0 To finis - 1
        tarih = DateAdd("d", i, trh)
        b(1, say) = Day(tarih) & vbLf & Format(tarih, "dddd")
        say = say + 2
    Next i

[D3].Resize(, say - 1) = b

    say = 1
    For i = 1 To finis
        k = Split(Cells(3, say + 3), vbLf)
        f1 = Len(k(0))
        f2 = Len(k(1))
        Cells(3, say + 3).Characters(1, f1).Font.Size = 11
        Cells(3, say + 3).Characters(f1 + 2, f2).Font.Size = 8
        say = say + 2
    Next i
Application.ScreenUpdating = True
End Sub

 

[k0081]

Çok teşekkür ederim. Tamamdır. Elinize sağlık.