Soru Tüm Sayfaların Font ve Yazı Boyutu

[TURKOLOG]

Herkese Merhaba
Excel Çalışma Kitabındaki Tüm Sayfaların
Tüm Sayfaların dolgu renginin beyaz
1. Satırlarının (A1den son dolu sütuna kadar) Kırmızı kalın 14 punto Time News Roman
A1den son dolu sütuna kadar dolgu renginin yeşil
2. Satırdan itibaren (A2 den son dolu satıra kadar) mavi 12 punto Time News Roman
olması için Workbook Öpen () kısmına nasıl bir kod yazabilirim .

 

[Saban Sertkaya]

Merhabalar,

Aşağıdaki şekilde deneyiniz.

Sub SelectSheets()
Application.ScreenUpdating = False
For a = 1 To Sheets.Count
Sheets(a).Select
Cells.Interior.ColorIndex = 2
Range(Cells(1, 1), [XFD1].End(xlToLeft)).Select
Selection.Interior.ColorIndex = 4
With Selection.Font
.Name = "Times New Roman"
.Size = 14
.Color = -16776961
.Bold = True
End With

Range(Cells(2, 1), [A1048576].End(xlUp)).Select
With Selection.Font
.Name = "Times New Roman"
.Size = 12
.Color = -1003520
End With
[A1].Select
Next
Sheets(1).Select
Application.ScreenUpdating = True
End Sub

 

[TURKOLOG]

Hocam elinize emeğinize sağlık ama kod çalışmadı.

 

[Saban Sertkaya]

Sayın TURKOLOG,
Çalışmayan yeri veya hata aldığınız satırı söylerseniz düzeltmeye çalışırız.
Veya mümkün ise örnek dosya paylaşınız, üzerinde bakalım.

 

[TURKOLOG]

Sayın TURKOLOG,
Çalışmayan yeri veya hata aldığınız satırı söylerseniz düzeltmeye çalışırız.
Veya mümkün ise örnek dosya paylaşınız, üzerinde bakalım.

Hocam geç crvap verdiğim ixin özür dilerim.
Il dışındaydım
Kodu Thisbook sayfasına yapıştırdım
Workbook Öpen olayına
SelectSheets

Başlığını yapıştırıp exceli kapatıp açtım.

Açılışta
Worsheet sınıfının Select yöntemi başarısız uayrisini verdi
Debug diyince

Sub SelectSheets()
Başlığı 3 kızım
Sheets(a) . Select kısmı sarı renge boyandı

 

[Korhan Ayhan]

Klavyenizde sorun mu var?

 

[TURKOLOG]

Hayır Korhan Hocam
Şimdi fark ettim kendi düzeltiyor bazı kelimeleri
Fark etmedim.
Çok özür dilerim.

 

[Korhan Ayhan]

Mesajınızı foruma post etmeden önce önizleme yaparsanız bu sorunu çözebilirsiniz.

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Private Sub Workbook_Open()
    Dim Sayfa As Worksheet, Son_Sutun As Integer, Son_Satir As Long
  
    Application.ScreenUpdating = False
      
    For Each Sayfa In ThisWorkbook.Worksheets
        With Sayfa
            .Select
            .Cells.Interior.ColorIndex = 2
            Son_Sutun = .Cells(1, .Columns.Count).End(1).Column
            With .Cells(1, 1).Resize(, Son_Sutun)
                .Font.Bold = True
                .Font.ColorIndex = 3
                .Font.Size = 14
                .Font.Name = "Times News Roman"
                .Interior.ColorIndex = 43
            End With
            Son_Satir = .Cells(.Rows.Count, 1).End(3).Row
            If Son_Satir > 1 Then
                With .Cells(2, 1).Resize(Son_Satir - 1)
                    .Font.Bold = True
                    .Font.ColorIndex = 41
                    .Font.Size = 12
                    .Font.Name = "Times News Roman"
                End With
                With .Cells(2, 1).Resize(Son_Satir - 1, Son_Sutun)
                    .Font.Size = 12
                    .Font.Name = "Times News Roman"
                End With
            End If
            .Columns.AutoFit
        End With
    Next

    Application.ScreenUpdating = True
End Sub

 

[TURKOLOG]

Deneyiniz.

Option Explicit

Private Sub Workbook_Open()
    Dim Sayfa As Worksheet, Son_Sutun As Integer, Son_Satir As Long
   
    Application.ScreenUpdating = False
       
    For Each Sayfa In ThisWorkbook.Worksheets
        With Sayfa
            .Cells.Interior.ColorIndex = 2
            Son_Sutun = .Cells(1, .Columns.Count).End(1).Column
            With .Cells(1, 1).Resize(, Son_Sutun)
                .Font.Bold = True
                .Font.ColorIndex = 3
                .Font.Size = 14
                .Font.Name = "Times News Roman"
                .Interior.ColorIndex = 43
            End With
            Son_Satir = .Cells(.Rows.Count, 1).End(3).Row
            If Son_Satir > 1 Then
                With .Cells(2, 1).Resize(Son_Satir)
                    .Font.Bold = True
                    .Font.ColorIndex = 41
                    .Font.Size = 12
                    .Font.Name = "Times News Roman"
                End With
            End If
        End With
    Next

    Application.ScreenUpdating = True
End Sub

Sayın @Korhan Ayhan Hocam elinize emeğinize sağlık.
Kod çalıştı ama şöyle ki
A2 den son dolu satır ve sütun arası yazı tipi Arial olarak kalıyor

 

[Korhan Ayhan]

Verdiğiniz koşullar arasında bu talebinizi göremedim.

Bahsettiğiniz aralıkta yazı fontu dışında bir değişiklik olacak mı?

 

[TURKOLOG]

Hocam sadece yazı tipi olayı eksik kalmış.
Diğer tüm kodlar sorunsuz çalıştı.

 

[Korhan Ayhan]

#9 nolu mesajımda ki kodu revize ettim. Son halini deneyiniz.

 

[TURKOLOG]

Hocam yazı tipi değişmedi. Hala arial oluyor ama elle değiştirebiliyorum

 

[Korhan Ayhan]

Nokta eklemeyi unutmuşum. Kodu düzelttim. Yeniden deneyiniz.

 

[TURKOLOG]

Sayın @Korhan Ayhan Hocam elinize kolunuza, yüreğinize sağlık. Kod sorunsuz olarak çalışıyor. Çok teşekkür ederim.