back to top
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,600FansLike
12,900FollowersFollow
20FollowersFollow
456FollowersFollow
97,000SubscribersSubscribe
Call Now Button