我是一名攻读计算机科学的A-Level学生,作为课程的一部分,我必须创建一个程序。我的程序是基于VBA的,它的目的是将用户表单中的输出详细信息输入到我的电子表格中:
Spreadsheet and the way it looks
我创建了这3个用户表单:
imgur.com/ftqfEBt - Userform 1
imgur.com/pT2WHuD - Userform 2
imgur.com/BHHGOPv - Userform 3
程序的目的是将用户表单中的所有详细信息输出到电子表格的特定部分。我得到的问题是userform 3,问题是我的代码不想输出到电子表格中。为了解释我的意思,我将把所有用户形式的代码放在下面:
Userform 1
Private Sub Forename_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'Set available characters to A-Z only
If (KeyAscii < 65 Or KeyAscii > 90) And (KeyAscii < 97 Or KeyAscii > 122) Then KeyAscii = 0
End Sub
Private Sub Surname_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'Set available characters to A-Z only
If (KeyAscii < 65 Or KeyAscii > 90) And (KeyAscii < 97 Or KeyAscii > 122) Then KeyAscii = 0
End Sub
Private Sub School_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'Set available characters to A-Z only
If (KeyAscii < 65 Or KeyAscii > 90) And (KeyAscii < 97 Or KeyAscii > 122) Then KeyAscii = 0
End Sub
Private Sub Candidate_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'Set available characters to 0-9 only
Select Case KeyAscii
Case vbKey0 To vbKey9, vbKeyBack, vbKeyClear, vbKeyLeft, _
vbKeyRight, vbKeyUp, vbKeyDown, vbKeyTab
Case Else
KeyAscii = 0
Beep
End Select
End Sub
Private Sub Closing_Click()
'Close the UserForm
Unload Me
End Sub
Private Sub Reset_Click()
'Clear all fields
Call UserForm_Initialize
End Sub
Sub ValidtyCheck()
'Check if all data is entered correctly
If Forename.Value = "" Then
Me.Forename.SetFocus
MsgBox "The Forename is Missing" 'Validation Check - Makes sure the Value is not empty
End If
If Surname.Value = "" Then
Me.Surname.SetFocus
MsgBox "The Surnamee is Missing" 'Validation Check - Makes sure the Value is not empty
End If
If School.Value = "" Then
Me.School.SetFocus
MsgBox "The School you previously attended to is Missing" 'Validation Check - Makes sure the Value is not empty
End If
If Candidate.Value = "" Then
Me.Candidate.SetFocus
MsgBox "The Candidate number is Missing" 'Validation Check - Makes sure the Value is not empty
End If
If IsNumeric(Candidate.Value) = False Then
MsgBox "Candidate number contains characters other than numbers" 'Validation Check - makes sure only numbers are entered
End If
If Trim(Me.Candidate.TextLength > 4) Then
Me.Candidate.SetFocus
MsgBox ("Candidate Number Contains more than 4 characters") 'Validation Check - Makes sure that no more than 4 characters are entered
End If
If Trim(Me.Candidate.TextLength < 4) Then
Me.Candidate.SetFocus
MsgBox ("Candidate Number Contains less than 4 characters") 'Validation Check - Makes sure that no less than 4 characters are entered
End If
End Sub
Sub Main()
On Error GoTo NoBlanks
Range("A1:A9000").SpecialCells(xlCellTypeBlanks).Value = "N/A"
NoBlanks:
Resume Next
' or add code here to execute when there are no empty cells
End Sub
Sub RemoveBlankRows()
'Deletes any row with blank cells located inside a designated range
On Error Resume Next
Dim rng As Range
Set rng = Range("A5:A9000").SpecialCells(xlCellTypeBlanks)
rng.EntireRow.Delete
End Sub
Sub InputDetails()
'Input details into specific cells
Set ws = Sheets("Details")
Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = Forename.Value
Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = Surname.Value
Range("A" & Rows.Count).End(xlUp).Offset(0, 2).Value = School.Value
Range("A" & Rows.Count).End(xlUp).Offset(0, 4).Value = Candidate.Value
End Sub
Private Sub Submit_Click()
'Output all information into the spreadsheet
Call ValidtyCheck
Call RemoveBlankRows
Call InputDetails
Unload Me
'opens 2nd userform
GCSEsTaken.Show
End Sub
Private Sub UserForm_Initialize()
'Empty ForenameTextBox
Forename.Value = ""
'Clear SurnameTextBox
Surname.Value = ""
'Clear SchoolTextBox
School.Value = ""
'Clear CandidateTextBox
Candidate.Value = ""
'Set Focus on ForenameTextBox
Forename.SetFocus
End Sub
这就是整个Userform 1的所有代码。我知道我发布了很多代码,但这是因为我需要为了显示它的确切错误。
Userform 2
Private Sub Closing_Click()
'Close the UserForm
Unload Me
End Sub
Private Sub Reset_Click()
'Clear all fields
Call UserForm_Initialize
End Sub
Private Sub GCSEsTaken_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'Set available characters to 0-9 only
Select Case KeyAscii
Case vbKey0 To vbKey9, vbKeyBack, vbKeyClear, vbKeyLeft, _
vbKeyRight, vbKeyUp, vbKeyDown, vbKeyTab
Case Else
KeyAscii = 0
Beep
End Select
End Sub
Sub InputDetails()
'Input details into specific cells
Range("A" & Rows.Count).End(xlUp).Offset(0, 5).Value = GCSEsTaken.Value
End Sub
Private Sub Submit_Click()
Call InputDetails
Unload Me
'opens 2nd userform
GCSE.Show
End Sub
Private Sub UserForm_Initialize()
'Empty GCSE's Taken TextBox
GCSEsTaken.Value = ""
End Sub
下一段代码是针对Userform 3的,出错的是在InputDetails()Sub中出错的东西。另外如果您有任何想法我可以缩短OptionsValues()Sub,那么请
Private Sub Closing_Click()
'Close the UserForm
Unload Me
End Sub
Private Sub Reset_Click()
'Clear all fields
Call UserForm_Initialize
End Sub
Private Sub OptionsValues()
MathsAx.Value = "A*"
MathsA.Value = "A"
MathsB.Value = "B"
MathsC.Value = "C"
MathsD.Value = "D"
MathsE.Value = "E"
MathsF.Value = "F"
EnglishLangAx.Value = "A*"
EnglishLangA.Value = "A"
EnglishLangB.Value = "B"
EnglishLangC.Value = "C"
EnglishLangD.Value = "D"
EnglishLangE.Value = "E"
EnglishLangF.Value = "F"
EnglishLangU.Value = "U"
EnglishLitAx.Value = "A*"
EnglishLitA.Value = "A"
EnglishLitB.Value = "B"
EnglishLitC.Value = "C"
EnglishLitD.Value = "D"
EnglishLitE.Value = "E"
EnglishLitF.Value = "F"
EnglishLitU.Value = "U"
SingSienceAx.Value = "A*"
SingSienceA.Value = "A"
SingSienceB.Value = "B"
SingSienceC.Value = "C"
SingSienceD.Value = "D"
SingSienceE.Value = "E"
SingSienceF.Value = "F"
SingSienceU.Value = "U"
DouScienceAx.Value = "A*"
DouScienceA.Value = "A"
DouScienceB.Value = "B"
DouScienceC.Value = "C"
DouScienceD.Value = "D"
DouScienceE.Value = "E"
DouScienceF.Value = "F"
DouScienceU.Value = "U"
TriScienceAx.Value = "A*"
TriScienceA.Value = "A"
TriScienceB.Value = "B"
TriScienceC.Value = "C"
TriScienceD.Value = "D"
TriScienceE.Value = "E"
TriScienceF.Value = "F"
TriScienceU.Value = "U"
REAx.Value = "A*"
REA.Value = "A"
REB.Value = "B"
REC.Value = "C"
RED.Value = "D"
REE.Value = "E"
REF.Value = "F"
REU.Value = "U"
ICTAx.Value = "A*"
ICTA.Value = "A"
ICTB.Value = "B"
ICTC.Value = "C"
ICTD.Value = "D"
ICTE.Value = "E"
ICTF.Value = "F"
ICTU.Value = "U"
DAndTAx.Value = "A*"
DAndTA.Value = "A"
DAndTB.Value = "B"
DAndTC.Value = "C"
DAndTD.Value = "D"
DAndTE.Value = "E"
DAndTF.Value = "F"
DAndTU.Value = "U"
HistoryAx.Value = "A*"
HistoryA.Value = "A"
HistoryB.Value = "B"
HistoryC.Value = "C"
HistoryD.Value = "D"
HistoryE.Value = "E"
HistoryF.Value = "F"
HistoryU.Value = "U"
GeographyAx.Value = "A*"
GeographyA.Value = "A"
GeographyB.Value = "B"
GeographyC.Value = "C"
GeographyD.Value = "D"
GeographyE.Value = "E"
GeographyF.Value = "F"
GeographyU.Value = "U"
MusicAx.Value = "A*"
MusicA.Value = "A"
MusicB.Value = "B"
MusicC.Value = "C"
MusicD.Value = "D"
MusicE.Value = "E"
MusicF.Value = "F"
MusicU.Value = "U"
DramaAx.Value = "A*"
DramaA.Value = "A"
DramaB.Value = "B"
DramaC.Value = "C"
DramaD.Value = "D"
DramaE.Value = "E"
DramaF.Value = "F"
DramaU.Value = "U"
SociologyAx.Value = "A*"
SociologyA.Value = "A"
SociologyB.Value = "B"
SociologyC.Value = "C"
SociologyD.Value = "D"
SociologyE.Value = "E"
SociologyF.Value = "F"
SociologyU.Value = "U"
PsychologyAx.Value = "A*"
PsychologyA.Value = "A"
PsychologyB.Value = "B"
PsychologyC.Value = "C"
PsychologyD.Value = "D"
PsychologyE.Value = "E"
PsychologyF.Value = "F"
PsychologyU.Value = "U"
EconomicsAx.Value = "A*"
EconomicsA.Value = "A"
EconomicsB.Value = "B"
EconomicsC.Value = "C"
EconomicsD.Value = "D"
EconomicsE.Value = "E"
EconomicsF.Value = "F"
EconomicsU.Value = "U"
FrenchAx.Value = "A*"
FrenchA.Value = "A"
FrenchB.Value = "B"
FrenchC.Value = "C"
FrenchD.Value = "D"
FrenchE.Value = "E"
FrenchF.Value = "F"
FrenchU.Value = "U"
SpanishAx.Value = "A*"
SpanishA.Value = "A"
SpanishB.Value = "B"
SpanishC.Value = "C"
SpanishD.Value = "D"
SpanishE.Value = "E"
SpanishF.Value = "F"
SpanishU.Value = "U"
ArabicAx.Value = "A*"
ArabicA.Value = "A"
ArabicB.Value = "B"
ArabicC.Value = "C"
ArabicD.Value = "D"
ArabicE.Value = "E"
ArabicF.Value = "F"
ArabicU.Value = "U"
PEAx.Value = "A*"
PEA.Value = "A"
PEB.Value = "B"
PEC.Value = "C"
PED.Value = "D"
PEE.Value = "E"
PEF.Value = "F"
PEU.Value = "U"
End Sub
Sub InputDetails()
'Input details into specific cells
If MathsAx.Value = True Then
Range("A" & Rows.Count).End(xlUp).Offset(0, 6).Value = MathsAx.Value
'THIS IS JUST A CODE TEST HENCE WHY MOST QUOTED OUT I DON'T KNOW BUT IT DOESNT GIVE ANY VALUES IN THE SPREADHSEET
'Else
' Cells(emptyRow, 6).Value = "No"
End If
'THIS CODE SEEMS TO WORK FOR THE PREVIOUS USERFORMS BUT THIS ONE IT DOESN'T WORK AT ALL AND I DON'T KNOW WHY
'Range("A" & Rows.Count).End(xlUp).Offset(0, 6).Value = Frame1.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 7).Value = Frame2.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 8).Value = Frame3.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 9).Value = Frame4.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 10).Value = Frame5.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 11).Value = Frame6.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 12).Value = Frame7.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 13).Value = Frame8.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 14).Value = Frame9.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 15).Value = Frame10.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 16).Value = Frame11.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 17).Value = Frame12.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 18).Value = Frame13.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 19).Value = Frame14.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 20).Value = Frame15.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 21).Value = Frame16.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 22).Value = Frame17.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 23).Value = Frame18.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 24).Value = Frame19.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 25).Value = Frame20.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 26).Value = Other.Value
End Sub
Private Sub Submit_Click()
Call OptionsValues
Call InputDetails
Unload Me
End Sub
Private Sub UserForm_Initialize()
'Empty Other TextBox
Other.Value = ""
Dim ctlX As MSForms.Control
For Each ctlX In Frame1.Controls
If TypeOf ctlX Is MSForms.OptionButton Then
If ctlX.Value Then
ctlX.Value = False
Exit For
End If
End If
Next
End Sub
我知道我发布了大量代码,但只是代码在彼此之间流动,我不明白为什么userform 3没有提供任何详细信息。