HomeVedantSri Varanasi ArticleExcel VBA Visitor Enquiry Form Software Projects by Pradip VedantSri

Excel VBA Visitor Enquiry Form Software Projects by Pradip VedantSri

5/5 - (2 votes)

This Workbook Code

'this is ThisWorkbook Code
Private Sub Workbook_Open()
Application.Visible = False
UserForm1.Show vbModeless
End Sub

VBA Userform1 Complete Codes

'=== Code to Remove Cut Icon in Userform ===
#If VBA7 Then
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
        (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
        (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
    Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
        (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    Private Declare PtrSafe Function DrawMenuBar Lib "user32" _
        (ByVal hWnd As LongPtr) As LongPtr
#Else
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
        (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
        (ByVal hWnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
        (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function DrawMenuBar Lib "user32" _
        (ByVal hWnd As Long) As Long
#End If

Const GWL_STYLE As Long = -16
Const WS_CAPTION As Long = &HC00000
Private Sub UserForm_Initialize()
    Dim hWnd As LongPtr
    Dim lStyle As LongPtr
    
    'Get UserForm handle
    #If VBA7 Then
        hWnd = FindWindow("ThunderDFrame", Me.Caption)
    #Else
        hWnd = FindWindow("ThunderDFrame", Me.Caption)
    #End If
    
    'Remove title bar
    lStyle = GetWindowLong(hWnd, GWL_STYLE)
    lStyle = lStyle And Not WS_CAPTION
    SetWindowLong hWnd, GWL_STYLE, lStyle
    DrawMenuBar hWnd
End Sub
'===================== End of Remove Cut Icon ================

'Code of Submit Button
Private Sub CommandButton1_Click()
    Dim ws As Worksheet
    Dim lRow As Long
    Dim purpose As String
    
    'Set worksheet reference
    Set ws = ThisWorkbook.Sheets("EnquiryForm")
    
    'Validate at least one purpose of visit is selected
    If Me.CheckBox1.Value = False And Me.CheckBox2.Value = False And _
       Me.CheckBox3.Value = False And Me.CheckBox4.Value = False And _
       Me.CheckBox5.Value = False Then
        MsgBox "Please select at least one purpose of visit!", vbExclamation
        Exit Sub
    End If
    
    'Build purpose string from checkboxes
    If Me.CheckBox1.Value Then purpose = purpose & "Meeting, "
    If Me.CheckBox2.Value Then purpose = purpose & "Delivery, "
    If Me.CheckBox3.Value Then purpose = purpose & "Interview, "
    If Me.CheckBox4.Value Then purpose = purpose & "Personal, "
    If Me.CheckBox5.Value Then purpose = purpose & "Other: "
    
    'Remove trailing comma and space
    If Len(purpose) > 0 Then
        purpose = Left(purpose, Len(purpose) - 2)
    End If
    
    'Write all data to worksheet
    With ws
        lRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        .Cells(lRow, 1).Value = "VIS-" & Format(lRow - 1, "0000") 'Auto ID
        .Cells(lRow, 2).Value = Now() 'Timestamp
        .Cells(lRow, 3).Value = Me.TextBox1.Value 'Name
        .Cells(lRow, 4).Value = Me.TextBox2.Value 'Company
        .Cells(lRow, 5).Value = Me.TextBox3.Value 'Contact
        .Cells(lRow, 6).Value = Me.TextBox4.Value 'Email
        .Cells(lRow, 7).Value = purpose 'Purpose from checkboxes
        .Cells(lRow, 8).Value = Me.TextBox5.Value 'Meeting With
        .Cells(lRow, 9).Value = Me.TextBox6.Value 'Expected Duration
        .Cells(lRow, 10).Value = Me.TextBox7.Value 'Vehicle Number
        .Cells(lRow, 11).Value = Me.ComboBox1.Value 'Status
        .Cells(lRow, 12).Value = Me.TextBox8.Value 'Notes
    End With
    
    'Show success message (BUT DON'T CLOSE FORM)
    MsgBox "Visitor details submitted successfully!" & vbCrLf & _
           "You can add another entry now.", vbInformation, "Success"
    
    'CLEAR ALL FIELDS FOR NEXT ENTRY
    Call ClearFormFields
End Sub

'Code of ClearFormFields
Private Sub ClearFormFields()
    'Clear all textboxes
    Me.TextBox1.Value = ""
    Me.TextBox2.Value = ""
    Me.TextBox3.Value = ""
    Me.TextBox4.Value = ""
    Me.TextBox5.Value = ""
    Me.TextBox6.Value = ""
    Me.TextBox7.Value = ""
    Me.TextBox8.Value = ""
    
    'Uncheck all checkboxes
    Me.CheckBox1.Value = False
    Me.CheckBox2.Value = False
    Me.CheckBox3.Value = False
    Me.CheckBox4.Value = False
    Me.CheckBox5.Value = False
    
    'Reset combobox
    Me.ComboBox1.Value = ""
    
    'Set focus back to first field
    Me.TextBox1.SetFocus
End Sub
'End of Submit Button code
'===================ONN Excel======================
'Code of ONN Excel
Private Sub CommandButton4_Click()
Unload Me
Application.Visible = True
End Sub
'===================OFF Excel======================
'Code of OFF Excel
Private Sub CommandButton5_Click()
Application.Visible = False
End Sub
'===================Exit Button======================
'Code of Exit Button
Private Sub CommandButton2_Click()
    'Save and close
    ThisWorkbook.Save
    Unload Me
    Application.Quit
End Sub
'===================ONN Excel======================
'Code of ONN Excel
Private Sub CommandButton3_Click()
Application.Visible = True
End Sub

Watch Video Here

VedantSri Sessional Reward Ceremony Toppers Students Image
VedantSri Sessional Reward Ceremony Toppers Students
3,556FansLike
11,847FollowersFollow
469FollowersFollow
94,800SubscribersSubscribe

Download This Course Syllabus in PDF

Call Now Button