Hiển thị tất cả các phông chữ có trong máy ppt

Hiển thị tất cả các phông chữ có trong
máy
Vào Notepad soạn nội dung sau rồi lưu lại dưới định dạng là .vbs.(
VD: Hien thi cac phong chu.vbs )
dim w
set w = createobject("word.application")
w.visible = true
dim d
set d = w.documents.add
dim iFonts
iFonts = w.fontnames.count
dim i
for i = 1 To iFonts
d.content.insertafter w.fontnames(i) & vbcrlf
d.content.insertafter "Hien thi Font chu" & vbcrlf
d.content.insertafter "Rat de dang ma khong can su dung phan mem ho
tro" & vbcrlf
d.content.insertafter "LuongHuuViet" & vbcrlf
d.content.insertafter "0913722650 0919324832 0913696000 0913650651"
& vbcrlf
next
dim rngParagraphs
for i = 1 To iFonts * 4
if (i + 3) mod 4 = 0 then
set rngParagraphs = d.range(d.paragraphs(i + 1).range.start,
d.paragraphs(i + 3).range.end)
rngParagraphs.select
w.selection.font.name = w.fontnames((i - 1) \ 4 + 1)
end if
next
msgbox "Ket Thuc"

Sau đó tiến hành thực thi file vừa tạo.