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

Popular posts from this blog

Powerpoint countdown and current time in slides VBA

Revit 2019 and up tab colorizer