~ ~ ~ Do you recognize this code? Need your assistance... 1

[TonyU]

[tt]
Hello all, I need help with this code that I was helped with a while back and I can't remember who helped me.

What this code does is display all fonts in any system on a large table with font samples which is working great,

NOW, I would like assistance on how to make the code display the same results
ONE FONT SAMPLE PER PAGE.

******************* code ***********************
Private Sub CommandButton1_Click()
Dim oDoc As Document, SampleText As String, FontName As String, _
MyRange As Range, StartRange As Range, i As Long

Set oDoc = Documents.Add
SampleText = Chr$(147) & "ABCDEFGHIJKLMNOPQRSTUVWXYZ" & _
Chr$(148) & ", " & _
Chr$(147) & "abcdefghijklmnopqrstuvwxyz" & Chr$(148) & ", " & _
Chr$(147) & "0123456789" & Chr$(148) & ", " & _
Chr$(147) & "The quick brown fox jumps over the lazy dog" & Chr$(148) & ", " & _
Chr$(145) & "àáâéêëìíîòóôùúû" & Chr$(146) & ", " & _
Chr$(145) & "(;,.:£€$?!)" & Chr$(146)

System.Cursor = wdCursorWait

With oDoc
For i = 1 To Application.FontNames.Count
FontName = Application.FontNames(i)
StatusBar = "Inserting " & FontName
Set MyRange = .Range
With MyRange
.Collapse wdCollapseEnd
.Font.Reset
.InsertAfter FontName & vbTab
End With
Set MyRange = .Range
With MyRange
.Collapse wdCollapseEnd
Set StartRange = MyRange.Duplicate
.InsertAfter SampleText
StartRange.End = MyRange.End
StartRange.Font.Name = FontName
.InsertAfter vbCr
End With
Next i

StatusBar = "Sorting list"
.Range.Sort FieldNumber:="Paragraphs"
.Paragraphs(1).Range.Text = "Font" & vbTab & "Sample" & vbCr
StatusBar = "Converting to table"
.Range.ConvertToTable Format:=wdTableFormatClassic1, _
AutoFit:=True

With .Tables(1)
.Rows.AllowBreakAcrossPages = False
.Rows(1).HeadingFormat = True
End With

End With

With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ", "
.Replacement.Text = "^l"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With

System.Cursor = wdCursorNormal

End Sub


******************* code *********************

Delete * from brain Where MaxLevel = "Full" and reaction = "Slow" order by StartOver
​

 

[SkipVought]

Hi,

In your With Tables(1) code, do this...

         With .Tables(1)
            For Each Row In .Rows
                If Row.Index > 2 Then
                    Row.Select
                    Selection.Paragraphs(1).PageBreakBefore = True
                End If
            Next
            .Rows(1).HeadingFormat = True
        End With

Hope this helps

Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[TonyU]

[tt]Thank you very much Kip, it worked great.

One more thing if I may, how could I increase the table and font size being displayed? it looks like it's displaying at the top of each page at about 25% or the width of it

I'd like it to display at at least 50 - 75% of the page.

I really appreciate your help with this.

Delete * from brain Where MaxLevel = "Full" and reaction = "Slow" order by StartOver
​

 

[TonyU]

[tt] Sorry about that. I meant, Thank you very much Skip.

Delete * from brain Where MaxLevel = "Full" and reaction = "Slow" order by StartOver
​