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

Revit area plans adding new types and references (Gross and rentable)

Powerpoint countdown and current time in slides VBA

Revit Python in Visual Studio Revit Stubs 2022 for Python Revit Intellisense