Sub OutputWithAllFontsInWord()
Dim doc As Document
Dim para As Paragraph
Dim targetText As String
Dim fontNames() As String
Dim i As Long
Set doc = ActiveDocument
targetText = "示例文字" '设置要应用字体并输出的目标文本，可按需修改
fontNames = Application.fontNames '获取Word应用程序中的所有字体名称列表
'在文档开头添加一个段落用于输出
Set para = doc.Paragraphs.Add
para.Range.Text = targetText & vbCrLf '先写入目标文本并换行
For i = LBound(fontNames) To UBound(fontNames)
para.Range.Font.Name = fontNames(i)
para.Range.InsertParagraphAfter '插入新段落
Set para = doc.Paragraphs(doc.Paragraphs.Count) '获取新段落
para.Range.Text = targetText & vbCrLf '写入目标文本并换行
Next i
End Sub
//这是AI编的，但运行时 fontNames = Application.fontNames '获取Word应用程序中的所有字体名称列表
这一行报参数不匹配的错。
//求会的大哥，就是一个字体效果展示文档，字符串就随便，但字体有很多很多，懒得一个一个调。

Sub OutputWithAllFontsInWord()
Dim doc As Document
Dim para As Paragraph
Dim targetText As String
Dim fontName
Set doc = ActiveDocument
targetText = "示例文字" '设置要应用字体并输出的目标文本，可按需修改
'在文档开头添加一个段落用于输出
Set para = doc.Paragraphs.Add
para.Range.Text = targetText & vbCrLf '先写入目标文本并换行
For Each fontName In Application.fontNames
para.Range.Font.Name = fontName
para.Range.InsertParagraphAfter '插入新段落
Set para = doc.Paragraphs(doc.Paragraphs.Count) '获取新段落
para.Range.Text = targetText & vbCrLf '写入目标文本并换行
Next fontName
End Sub