در نسخه‌های قدیمی‌تر Word (بسیار قدیمی‌تر، مانند Word برای ویندوز 2)، ویژگی‌ای وجود داشت که به شما امکان می‌داد به سرعت فهرستی از فونت‌ها را روی سیستم خود چاپ کنید. متأسفانه دیگر اینطور نیست. با این حال، می توانید به راحتی یک ماکرو ایجاد کنید که بتواند چنین لیستی را برای شما جمع کند:
Sub ListFontNames() Dim J As Integer Dim NewDoc As DocumentCreate a new document Set NewDoc = Documents.AddAdd font names to document For J = 1 To FontNames.Count Selection.TypeText (FontNames(J)) Selection.TypeParagraph Next J End Sub
ماکرو یک سند جدید ایجاد می کند و سپس به سادگی از مجموعه FontNames عبور می کند و هر یک از نام ها را به سند اضافه می کند. سرعت کار ماکرو به تعداد فونت هایی که روی سیستم خود نصب کرده اید بستگی دارد.
اگر چیزی کمی دقیق تر می خواهید، می توانید از ماکرو زیر استفاده کنید. یک سند ایجاد می کند، اما سپس همه نام فونت ها را در یک جدول قرار می دهد. در ستون دوم جدول، یک نمونه فرمت شده از فونت را ارائه می دهد.
Sub FontExamples() Dim J As Integer Dim F As Integer Dim sTemp As String Dim sTest As String Dim Continue As Integer Dim rng As Range Dim FontTable As Table Dim NewDoc As DocumentSpecify the sample text for second column sTest = "ABCDEFG abcdefg 1234567890"Check to see if the user wants to proceed F = FontNames.Count sTemp = "There are " & F & " fonts on this system." sTemp = sTemp & "Building the document may take quite a while." sTemp = sTemp & "Do you want to continue?" Continue = MsgBox(sTemp, vbYesNo, "Build Font List") If Continue = vbYes ThenPut together a string that contains the table contents sTemp = "Font Name" & vbTab & "Font Example" For J = 1 To F sTemp = sTemp & vbCr & FontNames(J) & vbTab & sTest Next JCreate a new document Set NewDoc = Documents.AddAdd string contents and convert to table Set rng = Selection.Range rng.Text = sTemp Set FontTable = rng.ConvertToTable(Separator:=vbTab, _ AutoFitBehavior:=wdAutoFitFixed)Set general table properties With FontTable .Borders.Enable = False .Range.Font.Name = "Arial" .Range.Font.Size = 10 .Rows(1).Range.Font.Bold = True .Rows(1).Range.Font.Size = 12 End WithGo through the sample cells and format them For J = 1 To F FontTable.Cell(J + 1, 2).Range.Font.Name = FontNames(J) Next JSort the table FontTable.Sort SortOrder:=wdSortOrderAscending End If End Sub
این ماکرو کمی بیشتر از ماکرو قبلی انجام می دهد. خود جدول نسبتاً سریع ایجاد می‌شود، اما گذر از هر یک از سلول‌های نمونه و قالب‌بندی آن با استفاده از فونت مناسب، زمان زیادی می‌برد. به همین دلیل است که ماکرو قبل از ادامه به شما امکان می دهد بدانید که چند قلم روی سیستم شما وجود دارد.
صرف نظر از اینکه کدام ماکرو را برای استفاده انتخاب می کنید، در نهایت یک لیست فونت کامل برای سیستم خود خواهید داشت. سپس می توانید آن را پرینت بگیرید و هنگام کار با Word آن را در دسترس داشته باشید.
