CW报底生成器

BH4BIN

70岁老战友给我要部队《报务员训练报底》，很难找到原版了，我用EXCEL给她生成打印装订好送她了，上个月聊天才知道，个人也可以玩CW，高兴的跟个孩子似的！！
Public Function CwMess(Optional ByVal l As Long = 4) As String
    '混合码报文生成函数,
    '参数 l: 生成字符串的长度,字符串中只有一个数字
    'BH4BIN 2024年1月27日
    Dim asc As Long
    Dim k As Boolean
    k = True
    Do
        asc = Int(Rnd() * 91)
        If asc < 10 And k = True Then
            CwMess = CwMess & asc
            k = False
        Else
            If asc >= 65 Then CwMess = CwMess & Chr(asc)
        End If
    Loop While Len(CwMess) < l
End Function

Public Function NumberMess(Optional ByVal l As Long = 4) As String
    '数码报文生成函数,
    '参数 l: 生成字符串的长度
    'BH4BIN 2024年1月27日
    Do
      NumberMess = NumberMess & Int(Rnd() * 10)
    Loop While Len(NumberMess) < l
End Function

Public Function StrMess(Optional ByVal l As Long = 4) As String
    '字码报文生成函数,
    '参数 l: 生成字符串的长度
    'BH4BIN 2024年1月27日
    StrMess = ""
    Do
        StrMess = StrMess & Chr(Int(Rnd() * (90 - 65 + 1)) + 65)
    Loop While Len(StrMess) < l
End Function

Public Function CwMessText(Optional ByVal ns As Long = 2, Optional ByVal l As Long = 4)
   '产生一组报文
   '参数ns: 0-产生数字，1-产生字母，其它数字，一组码中只有一个数字的混码，默认产生混码
   '    l:  每组报文的长度，默认一组为4个字符
   'BH4BIN 2024年1月27日
   If ns = 0 Then
      CwMessText = NumberMess(l)
   ElseIf ns = 1 Then
      CwMessText = StrMess(l)
   Else
      CwMessText = CwMess(l)
   End If
End Function

Public Function IsExistsSheetName(SheetName As String) As Boolean
    '如果目标工作表存在，返回TRUE；否则，返回FALSE
    '参数：SheetName 工作表名
    'BH4BIN 2024年1月27日
    Dim tempSheet As Worksheet
    IsExistsSheetName1 = False
    For Each tempSheet In ActiveWorkbook.Worksheets
        If tempSheet.Name = SheetName Then
            IsExistsSheetName = True
            Exit For
        End If
    Next tempSheet
End Function

Sub Head()
   '表格头
   'BH4BIN 2024年1月27日
   Dim h1() As Variant
   Dim h2() As Variant
   h1 = Array("发往", "来自", "附注")
   h2 = Array("号数", "组数", "等级", "月日", "时分", "记时签名")
   Range("A1").Resize(UBound(h1) + 1, LBound(h1) + 1) = WorksheetFunction.Transpose(h1)
   Range("D1").Resize(LBound(h2) + 1, UBound(h2) + 1) = h2
End Sub

Sub Main()
   '主程序
   'BH4BIN 2024年1月27日
   Dim r As Long
   Dim c As Long
   Dim i As Long
   ReDim d(11, 11)
   For i = 0 To 2
      For r = 0 To 9
         d(0, r) = r + 1
         For c = 0 To 9
            d(r + 1, c) = CwMessText(i, 4)
         Next c
         d(r + 1, c) = (r Mod 10) * 10 + 10
      Next r
      If i = 0 Then
         If IsExistsSheetName("数码") Then
            ActiveWorkbook.Sheets("数码").Select
         Else
            Worksheets.Add.Name = "数码"
         End If
      ElseIf i = 1 Then
         If IsExistsSheetName("字码") Then
            ActiveWorkbook.Sheets("字码").Select
         Else
            Worksheets.Add.Name = "字码"
         End If
      Else
         If IsExistsSheetName("混码") Then
            ActiveWorkbook.Sheets("混码").Select
         Else
            Worksheets.Add.Name = "混码"
         End If
      End If
      Call Head
      Range("A4").Resize(UBound(d, 1), UBound(d, 2)).NumberFormatLocal = "@"
      Range("A4").Resize(UBound(d, 1), UBound(d, 2)) = d
      Call SetCellFormat
   Next i
End Sub

BG4GOV

好文章。谢谢。