CW报底生成器
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
好文章。谢谢。
页:
[1]