Cách lấy danh sách font chữ cài sẵn trong Excel

Trong quá trình chạy VBA, có thể bạn sẽ phải chọn một font chữ trong danh sách các font được cài sẵn trong Excel.  Hoặc đôi khi bạn phải kiểm tra thử xem font chữ bạn muốn đã được cài sẵn hay chưa. Cách làm đơn giản nhất là tìm kiếm font chữ trong hộp thoại Font thông qua thanh công cụ Formatting. Trong hộp thoại sẽ có 1 danh sách xổ xuống các font chữ hiện đang được cài đặt sẵn trong máy, và để lấy được danh sách ấy ra ngoài thì bạn phải cần sử dụng đến lệnh VBA.

Chuỗi câu lệnh dưới đây sẽ hiển thị danh sách các font chữ đã được định dạng trong cột A của bảng tính. Bằng lệnh FindControl, bạn có thể tìm được tab quản lý font chữ bên trong thanh công cụ Formatting. Nếu chẳng may không tìm thấy được (có thể do lỗi người dùng vô tình xóa mất) một thanh điều khiển CommandBar sẽ được thiết lập tạm thời để làm bộ nhớ tạm cho font chữ đó.

Sub ShowInstalledFonts()
    Set FontList = Application.CommandBars("Formatting").FindControl(ID:=1728)
    
'   If Font control is missing, create a temp CommandBar
    If FontList Is Nothing Then
        Set TempBar = Application.CommandBars.Add
        Set FontList = TempBar.Controls.Add(ID:=1728)
    End If
    
'   Put the fonts into column A
    Range("A:A").ClearContents
    For i = 0 To FontList.ListCount - 1
        Cells(i + 1, 1) = FontList.List(i + 1)
    Next i
    
'   Delete temp CommandBar if it exists
    On Error Resume Next
    TempBar.Delete
End Sub

Công thức dưới đây sử dụng thuật toán tương tự với hàm ShowInstalledFonts. Kết quả trả về sẽ là TRUE nếu như font chữ cần tìm đã được cài sẵn trong máy.

Function FontIsInstalled(sFont) As Boolean
'   Returns True if sFont is installed
    FontIsInstalled = False
    Set FontList = Application.CommandBars("Formatting").FindControl(ID:=1728)
    
'   If Font control is missing, create a temp CommandBar
    If FontList Is Nothing Then
        Set TempBar = Application.CommandBars.Add
        Set FontList = TempBar.Controls.Add(ID:=1728)
    End If
    
    For i = 0 To FontList.ListCount - 1
        If FontList.List(i + 1) = sFont Then
            FontIsInstalled = True
            On Error Resume Next
            TempBar.Delete
            Exit Function
        End If
    Next i

'   Delete temp CommandBar if it exists
    On Error Resume Next
    TempBar.Delete
End Function

Ví dụ dưới đây sẽ chỉ cho bạn cách sử dụng lệnh trên trong VBA. Thông báo sẽ hiện kết quả là TRUE nếu như trong hệ thống đang cài sẵn font chữ Comic Sans MS

MsgBox FontIsInstalled("Comic Sans MS")