Monday, November 17, 2014

VB Code for made a form.

You can entry this code and show the magic



Private Sub Form_Open(Cancel As Integer)
'ÕDoCmd.Maximize
Label50.Caption = ""
Text49.Enabled = False


Form.DataEntry = True
Form.Caption = "              ...Data Entry Form..."
Special.ControlTipText = "<Select one Please>"
Text24.InputMask = "99/99/0000;0; "
Text26.InputMask = "99/99/0000;0; "
Text62.InputMask = "99/99/0000;0; "
End Sub


----------------------------------------------------------------------------------

Private Sub Form_Timer()

Me.TimerInterval = 1000
'Text65.Value = "Now Time is- " & Time()
'Text65.BorderColor = Rnd * 16711680
'Text65.Left = Rnd * 9500
'Text65.BorderStyle = Rnd * 6
'Text65.TextAlign = Rnd * 3
Me.Label20.ForeColor = Rnd * 2147483633
Label20.Top = Rnd * 50
Label20.Left = Rnd * 100
Label20.BackColor = Rnd * 987654321
Me.Branch_Name.Requery
Me.Desection.Requery
Me.OnLoad = True
'Text65.FontSize = "22"
'Text65.ForeColor = Rnd * 8421376
'Text65.FontBold = True
'Text65.Height = 600
'Text65.Width = 10500
'Text65.TabStop = False
Form.Caption = "              ...Data Entry Form...                         Now Time: " & Time()
End Sub

----------------------------------------------------------------------------------

Private Sub Id_No_LostFocus()
On Error GoTo Err_Id_No_LostFocus

IDNO = Trim(Id_No.Value)

Exit_Id_No_LostFocus:
    Exit Sub

Err_Id_No_LostFocus:
    MsgBox Err.Description + "Not Nes Id Holder"
    Resume Exit_Id_No_LostFocus

End Sub


----------------------------------------------------------------------------------

Private Sub Name_Enter()

If Not IsNull(Id_No) And IsNull(Text62) Then
Dim BJoDate As Date
BJoDate = InputBox("Branch Joinig Date Entry", "Date Entry ")
Me.Text62.Value = (BJoDate)
Else
    If IsNull(Id_No) Then
    MsgBox "Id No Is Null, Please Entry Id No"
        End If
End If
If IsNull(Text24) Then
Me.Text24.Value = (BJoDate)
Else
Text24.Value = Me.Text24.Value
End If
End Sub

----------------------------------------------------------------------------------

Private Sub Special_Enter()
Me.Special.Dropdown

End Sub

Private Sub Special1_LostFocus()
'If Me.Special1.Value <> 0 Then
'DoCmd.OpenQuery "IDData"
'End If
End Sub

Private Sub Text21_Enter()

DueBranchCode.Value = Text21
Me.Text21.Dropdown
End Sub


----------------------------------------------------------------------------------

Private Sub Text22_Enter()

If Text21.Value = "101" Then
Text49.Locked = False
Text49.Enabled = True
Label50.Caption = "cÖmwZKvjxb"
End If
If Text21.Value <> "101" Then
Text49.Enabled = False
Label50.Caption = "***"
PragnanceLeaveDate.Value = ""
End If
Me.Text22.Dropdown
End Sub



----------------------------------------------------------------------------------


Private Sub Text22_LostFocus()
On Error GoTo Err_Text22_LostFocus
'If Text22.Text = 11 Then
'Special.Value = "D"
'End If
'If Text22.Text = 1 Then
'Special.Value = "A"
'End If
'If Text22.Text = 2 Then
'Special.Value = "PO"
'End If
'If Text22.Text = 3 Then
'Special.Value = "M"
'End If
'If Text22.Text = 4 Then
'Special.Value = "M"
'End If
'If Text22.Text = 6 Then
'Special.Value = "S"
'End If
'If Text22.Text = 7 Then
'Special.Value = "CM"
'End If
'If Text22.Text = 8 Then
'Special.Value = "CM"
'End If
'If Text22.Text = 9 Then
'Special.Value = "CM"
'End If
'If Text22.Text = 10 Then
'Special.Value = "TCM"
'End If
'If Text22.Text = 5 Then
'Special.Value = "TO"
'End If

If Text22.Value < 1 > 20 Then
Special.Value = "Not Aplicable"
End If
If Text22.Value = 13 Then
'Special.Value = "Pion"
Me.PFatherName.Visible = True
Me.PAddress.Visible = True
Me.PRemarks.Visible = True
Me.Text26.Visible = False
Else

Me.PFatherName.Visible = False
Me.PAddress.Visible = False
Me.PRemarks.Visible = False
Me.Text26.Visible = True
End If
Me.Special.Requery
Exit_Text22_LostFocus:
    Exit Sub

Err_Text22_LostFocus:
    MsgBox Err.Description
    Resume Exit_Text22_LostFocus
End Sub


----------------------------------------------------------------------------------



Private Sub Text26_Enter()

If Text21.Value <> "101" Then
DueBranchCode.Value = 0
End If
End Sub


----------------------------------------------------------------------------------

Private Sub Command37_Click()
On Error GoTo Err_Command37_Click

    Dim stDocName As String
    Dim stLinkCriteria As String

    stDocName = "BranchWdataentry"
    DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_Command37_Click:
    Exit Sub

Err_Command37_Click:
    MsgBox Err.Description
    Resume Exit_Command37_Click
   
End Sub




----------------------------------------------------------------------------------




Private Sub Command20_Click()
On Error GoTo Err_Command20_Click


    DoCmd.Close

Exit_Command20_Click:
    Exit Sub

Err_Command20_Click:
    MsgBox Err.Description
    Resume Exit_Command20_Click
   
End Sub


 
----------------------------------------------------------------------------------




Private Sub Command39_Click()
On Error GoTo Err_Command39_Click

    Dim stDocName As String

    stDocName = "CRFormData"
    DoCmd.OpenReport stDocName, acPreview
    Form.Visible = False
Exit_Command39_Click:
    Exit Sub

Err_Command39_Click:
    MsgBox Err.Description
    Resume Exit_Command39_Click
   
End Sub


----------------------------------------------------------------------------------


Private Sub BWC_Click()
On Error GoTo Err_BWC_Click

    Dim stDocName As String
    Dim stLinkCriteria As String

    stDocName = "correction"
    DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_BWC_Click:
    Exit Sub

Err_BWC_Click:
    MsgBox Err.Description
    Resume Exit_BWC_Click
   
End Sub

No comments:

Post a Comment