VBA打造Excel版“我爱背单词”

《VBA打造Excel版“我爱背单词”》相关程序代码
__________________________________________________________________________________________


Option Explicit
Private Declare Sub keybd_event Lib "user32" _
(ByVal bvk As Byte, _
ByVal bsan As Byte, _
ByVal dwflags As Long, _
ByVal dwextra As Long)

Const int_C = 42
Dim b_Mark As Boolean '是否要音标提示
Dim b_FirstLetter As Boolean '是否要提示首字母
Dim b_WordLength As Boolean '是否要提示单词长度
Dim int_start As Integer
Dim int_len As Integer
Dim int_WordCount As Integer
Dim int_postion As Integer
Dim int_level As Integer
Dim EnglishWord As String
Dim Sheet As Object
Dim int_R As Integer
Dim int_W As Integer

Private Sub cmdCancel_Click()
Unload Me
End Sub

Private Sub cmdOK_Click()
Dim scro As Integer
If EnglishWord = Trim(tbWord.Value) Then
int_R = int_R + 1
If int_level <> 5 Then
setLevel int_level + 1, int_postion
setFontColor int_postion, int_level + 1
End If
Else
int_W = int_W + 1
If int_level <> 0 Then
setLevel int_level - 1, int_postion
setFontColor int_postion, int_level - 1
End If
End If
scro = int_C * (int_R - int_W / 3)
If scro < 0 Then
scro = 0
End If
lblWord.Caption = "词汇量（四级）：" & scro
int_postion = int_postion + 1
ShowWord int_postion
End Sub

Private Sub setFontColor(p As Integer, l As Integer)
Dim colour As Integer
Select Case l
Case 0: colour = 0
Case 1: colour = 3
Case 2: colour = 41
Case 3: colour = 50
Case 4: colour = 54
Case 5: colour = 38
End Select
With Sheet
Cells(p, 1).Font.ColorIndex = colour
Cells(p, 2).Font.ColorIndex = colour
Cells(p, 3).Font.ColorIndex = colour
Cells(p, 4).Font.ColorIndex = colour
End With
End Sub

Private Sub cmdOption_Click()
If Me.Height <> 230 Then
cmdOption.Caption = "<<设置"
Me.Height = 230
Else
cmdOption.Caption = ">>设置"
Me.Height = 350
End If
End Sub

Private Sub UserForm_Initialize()
Dim str As String
'开始位置参数初始化
With cmbBegin
.AddItem ("1")
.AddItem ("1/16")
.AddItem ("1/8")
.AddItem ("1/4")
.AddItem ("1/2")
.AddItem ("3/4")
.AddItem ("7/8")
.AddItem ("15/16")
End With
cmbBegin.Text = "1"
'测试单词数量参数初始化
With cmbLength
.AddItem "1x"
.AddItem "2x"
.AddItem "4x"
.AddItem "8x"
End With
cmbLength.Text = "1x"
'测试单词数量基数初始化
tbBasic.Text = 100
'记忆程度参数初始化
With cmbLevel
.A

ddItem 0
.AddItem 1
.AddItem 2
.AddItem 3
.AddItem 4
.AddItem 5
End With
cmbLevel.Value = 0
Set Sheet = Application.ActiveSheet
Me.Caption = MainForm.Caption & "-" &
'统计总行数
int_WordCount = 1
Do
str = Sheet.Cells(int_WordCount, 1)
If str <> "" Then
int_WordCount = int_WordCount + 1
Else
Exit Do
End If
Loop
int_R = 0
int_W = 0
Me.Height = 230
'INSERT键切换至覆盖模式
keybd_event 45, 0, 1, 0
End Sub

Private Function getBegin(lc As Integer, str As String) As Integer
Dim spilt As Integer
spilt = 1
Select Case str
'Case "1": spilt = 1
Case "1/16": spilt = lc / 16
Case "1/8": spilt = lc / 8
Case "1/4": spilt = lc / 4
Case "1/2": spilt = lc / 2
Case "3/4": spilt = lc * 3 / 4
Case "7/8": spilt = lc * 7 / 8
Case "15/16": spilt = lc * 15 / 16
End Select
getBegin = spilt
End Function

Private Function getLen(str As String) As Integer
Dim n As Integer
Select Case str
Case "1x": n = 1
Case "2x": n = 2
Case "4x": n = 4
Case "8x": n = 8
End Select
getLen = n
End Function

Private Sub ShowWord(ByVal p As Integer)
Do While Sheet.Cells(p, 4) <> int_level And _
p < int_WordCount And _
int_R + int_W < int_len
p = p + 1
Loop
If int_R + int_W > int_len Or _
p > int_WordCount Then
If int_R > 0 Or int_W > 0 Then
MsgBox "测试完成!", vbInformation
Else
MsgBox "请重新设置测试范围和单词熟练程度", vbCritical
End If
Exit Sub
End If
lblWordCount.Caption = "拼写单词数：" & _
int_R + int_W & _
"/" & int_len
lblEnglish.Caption = Sheet.Cells(p, 3)
If b_Mark = True Then
lblMark.Caption = Sheet.Cells(p, 2)
Else
lblMark.Caption = ""
End If
EnglishWord = Sheet.Cells(p, 1)
If b_FirstLetter = True Then
'取第一个字母作为提示
tbWord.Text = Left(EnglishWord, 1)
Else
tbWord.Text = ""
End If
If b_WordLength = True Then
Do While Len(tbWord.Text) < Len(EnglishWord)
tbWord.Text = tbWord.Text + "@"
Loop
End If
If b_FirstLetter = True Then
tbWord.SelStart = 1
Else
tbWord.SelStart = 0
End If
tbWord.SetFocus
int_postion = p
End Sub

Private Sub setLevel(p As Integer, pos As Integer)
Sheet.Cells(pos, 4) = p
End Sub

Private Sub cmdStart_Click()
int_start = getBegin(int_WordCount, cmbBegin.Value)
int_len = getLen(cmbLength.Value) * tbBasic.Value
int_postion = int_start
int_level = cmbLevel.Value
'是否提示参数初始化
b_M

ark = chkMark.Value
b_FirstLetter = chkFirstLetter.Value
b_WordLength = chkWordLength
lblWord.Caption = "词汇量: 0"
lblWordCount.Caption = "拼写单词数：" & int_len
lblMark.Caption = ""
ShowWord int_postion
End Sub