Sub Test() Dim s As Shape Dim n As Integer Dim dLeft As Double Dim dBottom As Double dLeft = 0.25 dBottom = ActivePage.SizeHeight - 0.4 For n = 1 To FontList.Count Step 5 Set s = ActiveLayer.CreateArtisticText(dLeft, dBottom, "Some Text String") s.Text.FontProperties.Name = FontList(n) dBottom = dBottom - 0.4 Next n With ActiveDocument .PrintSettings.PostScript.DownloadType1 = False .PrintSettings.PostScript.TrueTypeToType1 = False .PrintOut .PrintSettings.PostScript.DownloadType1 = True .PrintSettings.PostScript.TrueTypeToType1 = True .PrintOut End WithEnd Sub