fonts in word Free Excel Macros (VBA) | Excel Programs

Copy Macro

'For online Excel courses click: https://www.excelsizeyeter.com/excelwithkenan.com/udemy_giris.php 
 
Sub ShowInstalledFonts()
Dim FontNamesCtrl As CommandBarControl, FontCmdBar As CommandBar, tFormula As String
Dim fontName As String, i As Long, fontCount As Long, fontSize As Integer
Dim stdFont As String
    fontSize = 0
    fontSize = InputBox("Enter Sample Font Size Between 8 And 30", _
        "Select Sample Font Size", 12)
    If fontSize = 0 Then Exit Sub
    If fontSize  30 Then fontSize = 30
    Set FontNamesCtrl = Application.CommandBars("Formatting").FindControl(ID:=1728)
    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
    Documents.Add
    stdFont = ActiveDocument.Paragraphs(1).Range.Font.Name
    ' add heading
    With ActiveDocument.Paragraphs(1).Range
        .Text = "Installed fonts:"
    End With
    LS 2
    ' list font names and font example on every other line
    For i = 0 To FontNamesCtrl.ListCount - 1
        fontName = FontNamesCtrl.List(i + 1)
        If i Mod 5 = 0 Then Application.StatusBar = "Listing font " & _
            Format(i / (fontCount - 1), "0 %") & " " & _
            fontName & "..."
        With ActiveDocument.Paragraphs(ActiveDocument.Paragraphs.Count).Range
            .Text = fontName
            .Font.Name = stdFont
        End With
        LS 1
        tFormula = "abcdefghijklmnopqrstuvwxyz"
        If Application.International(wdProductLanguageID) = 47 Then
            tFormula = tFormula & "æøå"
        End If
        tFormula = tFormula & UCase(tFormula)
        tFormula = tFormula & "1234567890"
        With ActiveDocument.Paragraphs(ActiveDocument.Paragraphs.Count).Range
            .Text = tFormula
            .Font.Name = fontName
        End With
        LS 2
    Next i
    ActiveDocument.Content.Font.Size = fontSize
    Application.StatusBar = False
    If Not FontCmdBar Is Nothing Then FontCmdBar.Delete
    Set FontCmdBar = Nothing
    Set FontNamesCtrl = Nothing
    ActiveDocument.Saved = True
    Application.ScreenUpdating = True
    Application.ScreenRefresh
End Sub

Private Sub LS(lCount As Integer)
' adds lCount new paragraph(s) at the end of the document
Dim i As Integer
    With ActiveDocument.Content
        For i = 1 To lCount
            .InsertParagraphAfter
        Next i
    End With
End Sub

No	Macro Name
1	fonts in word
2	excel operators hk
3	list fonts with samples
4	format cell / fonts window
5	fonts window
6	print fonts to a sheet / page
7	excel fonts
8	excel fonts 2
9	Web Options Fonts Dialog Window
10	right word retrieval
11	Search for a word in 30 excel files
12	password protection
13	unlock a locked cell on a sheet / page with a double click
14	Highlight Cells with Wrong Words: This code is for you if it becomes difficult to check all cells due to typos. It controls each cell in the selection and highlights the cell with a misspelled word.
15	worde writes a report with or without internet connection
16	breaking sheet / page protection
17	remove the sheet / page protection password
18	How can I break the protection password of the sheet / page I have previously protected
19	to break the sheet / page protection (use it if you forgot)
20	Track and Report User Changes in an Excel worksheet or workbook

Excel Free Macros (VBA)

Fonts İn Word

Online Excel Courses

Services

How can we help you?

Subscribe to our Youtube Channel?

Keywords