excel fontları 2 Hazır Excel Makroları (VBA) | Excel Programları

Makroyu Kopyala

'Excel Makro (VBA) online eğitimleri için: https://www.excelsizeyeter.com/excelsizeyeter.com/udemy_giris.php adresine tıklayınız. Bir eğitim alana bir eğitim bedavadır. İkinci eğitim olarak Excel, Excel pratik çözümler, finans eğitimleri vb. alabilirsiniz.

Sub ShowInstalledFonts()
Const StartRow As Integer = 4
Dim FontNamesCtrl As CommandBarControl, FontCmdBar As CommandBar, tFormula As String
Dim fontName As String, i As Long, fontCount As Long, fontSize As Integer
    fontSize = 0
    fontSize = Application.InputBox("Enter Sample Font Size Between 8 And 30", _
         "Select Sample Font Size", 12, , , , , 1)
    If fontSize = 0 Then Exit Sub
    If fontSize  30 Then fontSize = 30
    Set FontNamesCtrl = Application.CommandBars("Formatting").FindControl(ID:=1728)
    ' If Font control is missing, create a temp CommandBar
    If FontNamesCtrl Is Nothing Then
        Set FontCmdBar = Application.CommandBars.Add("TempFontNamesCtrl", _
            msoBarFloating, False, True)
        Set FontNamesCtrl = FontCmdBar.Controls.Add(ID:=1728)
    End If
    Application.ScreenUpdating = False
    fontCount = FontNamesCtrl.ListCount
    Workbooks.Add
    ' list font names in column A and font example in column B
    For i = 0 To FontNamesCtrl.ListCount - 1
        fontName = FontNamesCtrl.List(i + 1)
        Application.StatusBar = "Listing font " & _
            Format(i / (fontCount - 1), "0 %") & " " & _
            fontName & "..."
        Cells(i + StartRow, 1).Formula = fontName
        With Cells(i + StartRow, 2)
            tFormula = "abcdefghijklmnopqrstuvwxyz"
            If Application.International(xlCountrySetting) = 47 Then
                tFormula = tFormula & "æøå"
            End If
            tFormula = tFormula & UCase(tFormula)
            tFormula = tFormula & "1234567890"
            .Formula = tFormula
            .Font.Name = fontName
        End With
    Next i
    Application.StatusBar = False
    If Not FontCmdBar Is Nothing Then FontCmdBar.Delete
    Set FontCmdBar = Nothing
    Set FontNamesCtrl = Nothing
    ' add heading
    Columns(1).AutoFit
    With Range("A1")
        .Formula = "Installed fonts:"
        .Font.Bold = True
        .Font.Size = 14
    End With
    With Range("A3")
        .Formula = "Font Name:"
        .Font.Bold = True
        .Font.Size = 12
    End With
    With Range("B3")
        .Formula = "Font Example:"
        .Font.Bold = True
        .Font.Size = 12
    End With
    With Range("B" & StartRow & ":B" & _
        StartRow + fontCount)
        .Font.Size = fontSize
    End With
    With Range("A" & StartRow & ":B" & _
        StartRow + fontCount)
        .VerticalAlignment = xlVAlignCenter
    End With
    Range("A4").Select
    ActiveWindow.FreezePanes = True
    Range("A2").Select
    ActiveWorkbook.Saved = True
End Sub
 -

Benzer Sonuçlar
No	Makro Adı
1	excel fontları 2
2	fontları sayfaya yazdırma
3	excel fontları
4	word'de fontlar
5	userformda hareketli gif
6	kes kopyalayi iptal et & aç
7	kes kopyalayı iptal etmek & aç
8	Dosyayı kim açtı 2
9	siyahla yazili .. lari çiktida görünmemesi için beyaz renkli olmasini istiyorum
10	mesajla tarih formatı olup olmadığını kontrol etme
11	süzme sütunda kırmızıları (butonla)
12	a, b sütunlarını topla cye yaz
13	menü index numaraları
14	belli sayfada true-false kontrolü
15	pc kapatma kodları
16	aynı olanların üzerlerine kayıt etme
17	butonları ve numaralarını görün
18	aynı olanın üzerine kayıt etme
19	kısayol tuşları listesi
20	Çift ve tek satırları farklı renk ve tasaarıma dönüştürmek (Bir satır kalın ve gri renkte, diğer satır normal)

Benzer Sonuçlar

Makro Adı

excel fontları 2

fontları sayfaya yazdırma

excel fontları

word'de fontlar

userformda hareketli gif

kes kopyalayi iptal et & aç

kes kopyalayı iptal etmek & aç

Dosyayı kim açtı 2

siyahla yazili .. lari çiktida görünmemesi için beyaz renkli olmasini istiyorum

mesajla tarih formatı olup olmadığını kontrol etme