是否有特殊原因需要将其保存在 Word 中？这只是为了可视化字体的所有字符吗？如果是这样，您可以使用 OS X 中的“字体册”并转到“打印”，选择“报告类型：Repetoire”，然后保存为 PDF。
编辑：似乎我错过了“自动化测试”。漠视。
Is there a particular reason why it needs to be in Word? Is this simply to visualize all the characters of a font? If so, you can use Font Book in OS X and go to Print, select Report Type: Repetoire, and save out to PDF.
Edit: Seems I missed "automated tests". Disregard.
Sub GenerateFontCatalog()
'
' Macro created in 05/14/2008 by Paulo Santos
'
Dim i As Long
Dim j As Long
Dim fnt As String
Dim doc As Document
Dim fnts() As String
'*
'* Get all font names
'*
Word.StatusBar = "Reading Font Names..."
ReDim fnts(Word.FontNames.Count)
For i = 1 To Word.FontNames.Count
fnts(i) = Word.FontNames.Item(i)
DoEvents
Next
'*
'* Sort alphabetically
'*
Word.StatusBar = "Sorting Font Names..."
For i = 1 To UBound(fnts)
For j = i + 1 To UBound(fnts)
If (fnts(i) > fnts(j)) Then
fnt = fnts(i)
fnts(i) = fnts(j)
fnts(j) = fnt
End If
Next
DoEvents
Next
Word.StatusBar = "Generating Font Catalog..."
Set doc = Application.Documents.Add()
doc.Activate
'*
'* Page configuration
'*
With ActiveDocument.PageSetup
.Orientation = wdOrientPortrait
.TopMargin = CentimetersToPoints(2)
.BottomMargin = CentimetersToPoints(2)
.LeftMargin = CentimetersToPoints(2)
.RightMargin = CentimetersToPoints(2)
End With
For i = 1 To UBound(fnts)
'*
'* Write font name
'*
Selection.Font.Name = "Arial"
Selection.Font.Size = 10
If (i > 1) Then
Selection.TypeParagraph
Selection.ParagraphFormat.KeepTogether = False
Selection.ParagraphFormat.KeepWithNext = False
Selection.TypeParagraph
End If
Selection.TypeText fnts(i)
Selection.ParagraphFormat.KeepWithNext = True
Selection.TypeParagraph
'*
'* Write font sample
'*
Selection.Font.Name = fnts(i)
Selection.Font.Size = 16
Selection.TypeText "ABCDEFGHIJKLMNOPQRSTUVWXYZ" & Chr(11)
Selection.TypeText "abcdefghijklmnopqrstuvwxyz" & Chr(11)
Selection.TypeText "0123456789"
Selection.ParagraphFormat.KeepTogether = True
DoEvents
Next
'*
'* Adjust cursor position
'*
Selection.HomeKey Unit:=wdStory
Selection.InsertBreak Type:=wdSectionBreakNextPage
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.MoveUp Unit:=wdLine, Count:=1
Word.StatusBar = "Generating Font Index..."
For i = 1 To UBound(fnts)
Selection.Font.Name = "Arial"
Selection.Font.Size = 10
Selection.TypeText fnts(i) & vbTab
Selection.Font.Name = fnts(i)
Selection.TypeText "ABC abc 123"
Selection.TypeParagraph
Next
'*
'* Split the document in two columns
'*
With Selection.Sections(1).PageSetup.TextColumns
.SetCount NumColumns:=2
.EvenlySpaced = True
.LineBetween = False
End With
Selection.HomeKey Unit:=wdStory, Extend:=True
Selection.ParagraphFormat.TabStops.Add Position:=Selection.Sections(1).PageSetup.TextColumns(1).Width, Alignment:=wdAlignTabRight, Leader:=wdTabLeaderSpaces
Selection.HomeKey Unit:=wdStory
Word.StatusBar = ""
End Sub
Geez... I've made something like that a long time ago... Yes, it's possible to do it.
I knew I had done something like this before. Going through some of my old emails I found a macro I've sent to a friend of mine containing exactly this. Here it is:
Sub GenerateFontCatalog()
'
' Macro created in 05/14/2008 by Paulo Santos
'
Dim i As Long
Dim j As Long
Dim fnt As String
Dim doc As Document
Dim fnts() As String
'*
'* Get all font names
'*
Word.StatusBar = "Reading Font Names..."
ReDim fnts(Word.FontNames.Count)
For i = 1 To Word.FontNames.Count
fnts(i) = Word.FontNames.Item(i)
DoEvents
Next
'*
'* Sort alphabetically
'*
Word.StatusBar = "Sorting Font Names..."
For i = 1 To UBound(fnts)
For j = i + 1 To UBound(fnts)
If (fnts(i) > fnts(j)) Then
fnt = fnts(i)
fnts(i) = fnts(j)
fnts(j) = fnt
End If
Next
DoEvents
Next
Word.StatusBar = "Generating Font Catalog..."
Set doc = Application.Documents.Add()
doc.Activate
'*
'* Page configuration
'*
With ActiveDocument.PageSetup
.Orientation = wdOrientPortrait
.TopMargin = CentimetersToPoints(2)
.BottomMargin = CentimetersToPoints(2)
.LeftMargin = CentimetersToPoints(2)
.RightMargin = CentimetersToPoints(2)
End With
For i = 1 To UBound(fnts)
'*
'* Write font name
'*
Selection.Font.Name = "Arial"
Selection.Font.Size = 10
If (i > 1) Then
Selection.TypeParagraph
Selection.ParagraphFormat.KeepTogether = False
Selection.ParagraphFormat.KeepWithNext = False
Selection.TypeParagraph
End If
Selection.TypeText fnts(i)
Selection.ParagraphFormat.KeepWithNext = True
Selection.TypeParagraph
'*
'* Write font sample
'*
Selection.Font.Name = fnts(i)
Selection.Font.Size = 16
Selection.TypeText "ABCDEFGHIJKLMNOPQRSTUVWXYZ" & Chr(11)
Selection.TypeText "abcdefghijklmnopqrstuvwxyz" & Chr(11)
Selection.TypeText "0123456789"
Selection.ParagraphFormat.KeepTogether = True
DoEvents
Next
'*
'* Adjust cursor position
'*
Selection.HomeKey Unit:=wdStory
Selection.InsertBreak Type:=wdSectionBreakNextPage
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.MoveUp Unit:=wdLine, Count:=1
Word.StatusBar = "Generating Font Index..."
For i = 1 To UBound(fnts)
Selection.Font.Name = "Arial"
Selection.Font.Size = 10
Selection.TypeText fnts(i) & vbTab
Selection.Font.Name = fnts(i)
Selection.TypeText "ABC abc 123"
Selection.TypeParagraph
Next
'*
'* Split the document in two columns
'*
With Selection.Sections(1).PageSetup.TextColumns
.SetCount NumColumns:=2
.EvenlySpaced = True
.LineBetween = False
End With
Selection.HomeKey Unit:=wdStory, Extend:=True
Selection.ParagraphFormat.TabStops.Add Position:=Selection.Sections(1).PageSetup.TextColumns(1).Width, Alignment:=wdAlignTabRight, Leader:=wdTabLeaderSpaces
Selection.HomeKey Unit:=wdStory
Word.StatusBar = ""
End Sub
像 MS Word 这样的程序无法告诉您字体中有哪些可用字符。据我的经验告诉你，只有Window的“字符映射表”应用程序可以显示。可以通过“附件”在“开始”菜单中找到“字符映射表”，或者通过“开始”、“运行...”并键入“charmap”，但没有方便的方法从“字符映射表”或 MS Word 中收集这些字符。
Programs like MS Word won't be able to tell you what characters are available in a font. As far as I can tell you from experience, only the Window's "Character Map" application can show you. Character Map can be found in your Start menu via Accessories, or alternatively by Start, Run..., and typing "charmap" but there's no convenient method to collect these characters from Character Map or MS Word.
Strictly in Word, I have no idea if it's possible, but since you can execute scripts in Word, I'm sure it's possible to read the font files and read their binary data to collect the available characters inside it.. that's the long-winded way, and possibly the only way to get what you desire.
I've not been able to find a suitable program online to do this for me either, sorry.
发布评论
评论（5）
是否有特殊原因需要将其保存在 Word 中？这只是为了可视化字体的所有字符吗？如果是这样，您可以使用 OS X 中的“字体册”并转到“打印”，选择“报告类型：Repetoire”，然后保存为 PDF。
编辑：似乎我错过了“自动化测试”。漠视。
Is there a particular reason why it needs to be in Word? Is this simply to visualize all the characters of a font? If so, you can use Font Book in OS X and go to Print, select Report Type: Repetoire, and save out to PDF.
Edit: Seems I missed "automated tests". Disregard.
天哪...我很久以前就做过类似的东西...是的，这是可能做到的。
一个好的开始是 MSDN
编辑添加：
我知道我以前做过类似的事情。浏览我的一些旧电子邮件，我发现了一个我发送给我的朋友的宏，其中包含这个内容。这里是：
Geez... I've made something like that a long time ago... Yes, it's possible to do it.
A good start is the MSDN
Edited to add:
I knew I had done something like this before. Going through some of my old emails I found a macro I've sent to a friend of mine containing exactly this. Here it is:
像 MS Word 这样的程序无法告诉您字体中有哪些可用字符。据我的经验告诉你，只有Window的“字符映射表”应用程序可以显示。可以通过“附件”在“开始”菜单中找到“字符映射表”，或者通过“开始”、“运行...”并键入“charmap”，但没有方便的方法从“字符映射表”或 MS Word 中收集这些字符。
严格来说，在Word中，我不知道这是否可能，但既然你可以在Word中执行脚本，我确信可以读取字体文件并读取它们的二进制数据以收集其中的可用字符..这就是长-曲折的方式，可能也是获得你想要的东西的唯一方法。
抱歉，我也无法在网上找到合适的程序来为我执行此操作。
Programs like MS Word won't be able to tell you what characters are available in a font. As far as I can tell you from experience, only the Window's "Character Map" application can show you. Character Map can be found in your Start menu via Accessories, or alternatively by Start, Run..., and typing "charmap" but there's no convenient method to collect these characters from Character Map or MS Word.
Strictly in Word, I have no idea if it's possible, but since you can execute scripts in Word, I'm sure it's possible to read the font files and read their binary data to collect the available characters inside it.. that's the long-winded way, and possibly the only way to get what you desire.
I've not been able to find a suitable program online to do this for me either, sorry.
插入是个好主意
并循环遍历需要使用宏进行测试的字体。
It will be nice idea to insert
and loop through the fonts that need to be tested using a macro.
似乎一个很好的折衷方案是使用 &#XXX; 创建一个 html 文件。每个字符的条目，然后用 MS Word 打开它。
Seems like a pretty good compromise is to create an html file with &#XXX; entries for each character and then open that with MS Word.