vendredi 1 mai 2015

CHECKBOX AND RADIO BUTTON TO RETURN CELL VALUE WHEN NEXT PREVIOS AND UPDATE BUTTONS ARE CLICKED

I am having trouble to create and run the checkbox and radio button. The checkbox must have a "yes" or "no" value and the radio button must return "male" or "female" value.

The checkbox and the radio must go along when previous and next button is clicked. Here is the code so far:

Private Sub CheckBoxEmail_Click()

End Sub

Private Sub OptionButtonFemale_Click()

End Sub

Private Sub OptionButtonMale_Click()

End Sub

Private Sub cmdCorrection_Click()

ActiveCell.Offset(0, 0) = cboLocation.Text

ActiveCell.Offset(0, 1) = txtDate.Text

ActiveCell.Offset(0, 2) = txtDirector.Text

ActiveCell.Offset(0, 3) = txtPay.Text

End Sub

Private Sub UserForm_Initialize()

Sheets("Sheet2").Activate

Cells(1, 1).Select

End Sub

Private Sub UserForm_Terminate()

Application.Visible = True

' Activating the sheet that contains the data

Sheets("Sheet2").Activate

cboLocation.Text = ActiveCell

txtDate.Text = ActiveCell.Offset(0, 1)

txtDirector.Text = ActiveCell.Offset(0, 2)

txtPay.Text = ActiveCell.Offset(0, 3)

End Sub

Private Sub cmdNext_Click()

Dim CurrentRow As Integer

' Determine the current row

CurrentRow = Application.ActiveCell.Row

If CurrentRow = Application.WorksheetFunction.CountA(Range("a:A")) Then

MsgBox "You are at the last entry in the data source." & vbCrLf & "You cannot _ move to the Next Entry", vbOKOnly, "Warning!"

Else

ActiveCell.Offset(1, 0).Select

cboLocation.Text = ActiveCell

txtDate.Text = ActiveCell.Offset(0, 1)

txtDirector.Text = ActiveCell.Offset(0, 2)

txtPay.Text = ActiveCell.Offset(0, 3)

End If

End Sub

Private Sub lblPay_Click()

End Sub

Private Sub cmdPrevious_Click()

Dim CurrentRow As Integer

' Determine the current row CurrentRow = Application.ActiveCell.Row

If CurrentRow = 1 Then

MsgBox "You are at the first entry in the data source." & vbCrLf & "You can't move to the Previous Entry", vbOKOnly, "Warning!"

Else

ActiveCell.Offset(-1, 0).Select

cboLocation.Text = ActiveCell.Offset(1, 0)

txtDate.Text = ActiveCell.Offset(1, 1)

txtDirector.Text = ActiveCell.Offset(1, 2)

txtPay.Text = ActiveCell.Offset(1, 3)

End If

End Sub

Private Sub cmdClear_Click()

cboLocation = "" txtDate = ""

txtDirector = ""

txtPay = ""

End Sub

Private Sub cmdDelete_Click()

Dim CurrentRow As Integer

' Select the row to delete, delete it and shift the rows upward

ActiveCell.EntireRow.Select

Selection.Delete Shift:=xlUp

' Refill controls with current info ' Determine the current row

CurrentRow = Application.ActiveCell.Row

' If you deleted the last row in the data source you need to move up one row

If CurrentRow = Application.WorksheetFunction.CountA(Range("A:A")) + 1 Then

ActiveCell.Offset(-1, 0).Select

cboLocation.Text = ActiveCell

txtDate.Text = ActiveCell.Offset(0, 1)

txtDirector.Text = ActiveCell.Offset(0, 2)

txtPay.Text = ActiveCell.Offset(0, 3)

' If you didn't delete the last row you can use the current row to fill in the form

Else

ActiveCell.Offset(0, 0).Select

cboLocation.Text = ActiveCell

txtDate.Text = ActiveCell.Offset(0, 1)

txtDirector.Text = ActiveCell.Offset(0, 2)

txtPay.Text = ActiveCell.Offset(0, 3)

End If

End Sub

Private Sub cmdExit_Click()

Unload frmEmployer

End Sub

Private Sub cmdUpdate_Click()

Dim NextRow As Integer

Dim Msg As String

Msg = "" ' Making sure a number is input for the pay

If IsNumeric(txtPay.Text) = False Then

Msg = "You did not enter a number for the amount of money you were paid." & vbCrLf

End If

' Making sure a date is input for the date

If IsDate(txtDate.Text) = False Then

Msg = Msg + "You did not enter a viable date in the date for the tournament"

End If

' Giving the user some feedback about there detectable errors

If Msg <> "" Then

MsgBox Msg

Exit Sub

End If

' Make sure the sheet that will contain the data is active

Sheets("Sheet2").Activate

' Determine the next empty row

NextRow = Application.WorksheetFunction.CountA(Range("A:A")) + 1

' Transfer the information

Cells(NextRow, 1) = cboLocation

Cells(NextRow, 2) = txtDate.Text

Cells(NextRow, 3) = txtDirector.Text

Cells(NextRow, 4) = txtPay.Text

' Clear the textboxes for the next entry

cboLocation = ""

txtDate = ""

txtDirector = ""

txtPay = ""

End Sub




Aucun commentaire:

Enregistrer un commentaire