Microsoft Office Forums - View Single Post

macropod · 08-04-2012, 04:12 PM

Attached is a table showing the widths of the std chracter set for 12pt TNR (I used a macro to get precise measurements - see below). As you can see (and as you can show your clients) specifying something as "two characters' width" is meaningless - 'W', for instance, is 3.375 times wider than 'i', when both are at the same point size. Start changing point sizes (as you might do when changing between headings & body text) and all you achieve is an even less meaningful designation, if such were possible.

Code:

Sub GetChrWidths()
Application.ScreenUpdating = False
Dim i As Long, l As Double, r As Double, x As Long, n As Long, StrTmp As String, StrChr As String
n = 144
With ActiveDocument
  With .PageSetup
    .PageWidth = CentimetersToPoints(55.88)
    .LeftMargin = CentimetersToPoints(0)
    .RightMargin = CentimetersToPoints(0)
    .TopMargin = CentimetersToPoints(0)
    .BottomMargin = CentimetersToPoints(0)
  End With
  With .Range
    .ParagraphFormat.Alignment = wdAlignParagraphLeft
    With .Font
      .Size = 10
      .Name = "Times New Roman"
    End With
    For x = 32 To 255
      With .Paragraphs.Last.Range
        .InsertAfter vbCr
        l = .Characters.Last.Information(wdHorizontalPositionRelativeToTextBoundary)
        StrTmp = ""
        For i = 1 To n
          StrTmp = StrTmp & Chr(x)
        Next
        .InsertAfter StrTmp
        r = .Characters.Last.Information(wdHorizontalPositionRelativeToTextBoundary)
        StrChr = StrChr & Chr(x) & vbTab & Format((r - l) / n, "0.000") & vbTab
        .Text = vbNullString
        DoEvents
      End With
    Next
    .InsertAfter Left(StrChr, Len(StrChr) - 1)
  End With
  With .PageSetup
    .PaperSize = wdPaperA4
    .Orientation = wdOrientLandscape
    .LeftMargin = CentimetersToPoints(2.5)
    .RightMargin = CentimetersToPoints(2.5)
    .TopMargin = CentimetersToPoints(2.5)
    .BottomMargin = CentimetersToPoints(2.5)
  End With
  .Range.Paragraphs.Last.Range.ConvertToTable Separator:=vbTab, Numrows:=16, NumColumns:=28
  With .Tables(.Tables.Count)
    .LeftPadding = 0
    .RightPadding = 0
    .TopPadding = 0
    .BottomPadding = 0
    .AllowAutoFit = True
    With .Range.ParagraphFormat
      .SpaceAfter = 3
      .SpaceBefore = 3
      .Alignment = wdAlignParagraphCenter
    End With
  End With
End With
Application.ScreenUpdating = True
End Sub