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.

Cách hiển thị tên font chữ

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ách kiểm tra xem liệu 1 font chữ nào đó đã được cài hay chưa?

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