关于选项按钮的VBA输出

时间:2016-05-10 19:52:33

标签: excel vba excel-vba output userform

我是一名攻读计算机科学的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没有提供任何详细信息。

0 个答案:

没有答案