Create font sheets to ID symbols by number in Unicode
Excel generates grids with fonts and number blow to print from 10 to 65535-
Attribute VB_Name = "FontSheets"
Sub GenerateUnicode()
Dim I As Long
Dim Row As Integer
Dim col As Integer
Const ColWidth = 16 ''max columns
Row = -1
Sheet1.Range("A:P").ColumnWidth = 4.8
For I = 10 To Int("&HFFFD")
If I Mod ColWidth = 0 Or I = 10 Then
Row = Row + 2 ''next row every 15 characters
col = 0
''Font cells format
SetCountFormat Sheet1.Range(Cells(Row + 1, 1), Cells(Row + 1, ColWidth))
SetFontFormat Sheet1.Range(Cells(Row, 1), Cells(Row, ColWidth))
End If
col = I Mod ColWidth + 1
Sheet1.Cells(Row, col).Value = ChrW(I) ''Call to insert unicode character
Sheet1.Cells(Row + 1, col) = I ''respective number to unicode character
Next I
End Sub
Sub SetFontFormat(RowRange As Range)
With RowRange
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
With .Font
.Name = "Arial Unicode MS"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
End With
End Sub
Sub SetCountFormat(RowRange As Range)
''Numbering format
With RowRange
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
With .Font
.Name = "Arial"
.Size = 6
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
.Borders(xlInsideHorizontal).LineStyle = xlNone
With .Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent5
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
End With
End Sub
Comments
Post a Comment