'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