User Form calculator (demonstration)
Calculator custom dialog box

the VBA code
0. Module declaration and Initialize event
Code 0a: Sub
UserForm
module declarations and Initialize event
Option Explicit ' Module level declarations Dim num1 As Double, num2 As Double Dim outRange As Range '' ============================ '' Module contents '' Written by Ian O'Connor '' excelatfinance.com ' ============================= ' 0. Start UserForm controls and events ' 0.0 Initialize Event ' 0.1 Form controls ' 0.1.1 Output Click ' 0.1.2 Close Click ' 1. Start Operator frame controls ' 1.1 Multiply Click ' 2. Start Input frame controls ' 2.1 Number #1 Spin Change ' 2.2 Number #1 Text KeyPress ' 2.3 Number #1 Text Change ' 2.4 Number #2 Spin Change ' 2.5 Number #2 Text KeyPress ' 2.6 Number #2 Text Change ' 3. Start Result frame controls ' 3.1 Result Change ' 4. Start Output frame controls ' 4.1 Output DropButtonClick ' 4.2 Output Click ' 5. Start calculation engine ' 5.1 Multiply ' 5.2 Divide ' ============================= ' ============================= ' 0. Start UserForm controls and events ' ============================= ' 0.1 Initialize Event Private Sub UserForm_Initialize() Dim BackColor As Long: BackColor = RGB(153, 255, 102) Dim BackColor2 As Long: BackColor2 = RGB(0, 102, 0) Dim ForColor As Long: ForColor = RGB(255, 255, 153) With Me .BackColor = BackColor .lblNumber1.BackColor = BackColor .lblNumber2.BackColor = BackColor .lblOutput.BackColor = BackColor .lblResult.BackColor = BackColor .fraInput.BackColor = BackColor .fraOutput.BackColor = BackColor .fraOperator.BackColor = BackColor .fraResult.BackColor = BackColor .chkOutput.BackColor = BackColor .optMultiply.BackColor = BackColor .optDivide.BackColor = BackColor .cmdClose.BackColor = BackColor2 .cmdOutput.BackColor = BackColor2 .cmdClose.ForeColor = ForColor .cmdOutput.ForeColor = ForColor .txtNumber1.Text = 1 .txtNumber2.Text = 1 .spnNumber1.Value = 1 .spnNumber2.Value = 1 .optMultiply.Value = True Call multiply1 ' Attach a ReduceStyleDropButton to the TextBox .txtOutputRange.DropButtonStyle = fmDropButtonStyleReduce .txtOutputRange.ShowDropButtonWhen = fmShowDropButtonWhenAlways End With End Sub '
0.1 Output frame control events
Code 0b: procedures
' ============================= ' 0.1 Form controls ' 0.1.1 Output Click Private Sub cmdOutput_Click() Dim Caption(0 To 4, 0 To 1) As String Caption(0, 0) = "First number" Caption(1, 0) = "Second number" Caption(2, 0) = "Result" Caption(3, 0) = "Operation" Caption(4, 0) = "Multiplication" Caption(4, 1) = "Division" On Error GoTo errorhandler outRange.Select Selection.Resize(1, 1).Select Application.ScreenUpdating = False With Selection .EntireColumn.ColumnWidth = 15 .Offset(0, 1).EntireColumn.ColumnWidth = 15 .Offset(0, 0).Value = Caption(0, 0) .Offset(0, 1).Value = Val(Me.txtNumber1) .Offset(1, 0).Value = Caption(1, 0) .Offset(1, 1).Value = Val(Me.txtNumber2) .Offset(2, 0).Value = Caption(2, 0) .Offset(2, 1).Value = Val(Me.txtResult) .Offset(2, 1).NumberFormat = "#,##0.000" .Offset(3, 0).Value = "Operation" If optMultiply.Value = True Then .Offset(3, 1).Value = Caption(4, 0) Else .Offset(3, 1).Value = Caption(4, 1) End If .Offset(3, 1).HorizontalAlignment = xlHAlignRight End With Application.ScreenUpdating = True lblOutput.Enabled = False chkOutput.Value = False cmdOutput.Enabled = False txtOutputRange.Text = "" txtOutputRange.Enabled = False Exit Sub errorhandler: MsgBox "You have entered an invalid range", vbCritical, "xlf Warning" txtOutputRange.Text = "" Exit Sub End Sub ' ============================= ' 0.1.2 Close Click Private Sub CmdClose_Click() FrmCalc.Hide End Sub ' ============================= ' ### End UserForm controls and events ' ============================= '
1. Operator frame control events
Code 1: procedures
' ============================= ' 1. Start Operator frame controls ' ============================= ' 1.1 Multiply Click Private Sub OptMultiply_Click() If txtNumber1.Text <> "" And txtNumber2.Text <> "" Then Call multiply1 Else txtResult.Text = "" End If Call txtResult_Change End Sub ' ============================= ' 1.1 Divide Click Private Sub OptDivide_Click() If txtNumber1.Text <> "" And txtNumber2.Text <> "" Then Call divide1 Else txtResult.Text = "" End If Call txtResult_Change End Sub ' ============================= ' ### End Operator frame controls ' ============================= '
2. Input frame control events
Code 2: procedures
' ============================= ' 2. Start Input frame controls ' ============================= ' 2.1 Number #1 Spin Change Private Sub SpnNumber1_Change() If txtNumber1.Text = "" Then spnNumber1.Value = 1 num1 = 1 End If txtNumber1.Text = spnNumber1.Value num1 = spnNumber1.Value End Sub ' ============================= ' 2.2 Number #1 Text KeyPress Private Sub txtNumber1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) Select Case KeyAscii ' Positive integers only Case Asc("0") To Asc("9") Case Else KeyAscii = 0 End Select End Sub ' ============================= ' 2.3 Number #1 Text Change Private Sub txtNumber1_Change() num1 = Val(txtNumber1) spnNumber1.Value = num1 If optMultiply.Value = True Then Call multiply1 Else Call divide1 End If End Sub ' ============================= ' 2.4 Number #2 Spin Change Private Sub SpnNumber2_Change() If txtNumber2.Text = "" Then spnNumber2.Value = 1 num2 = 1 End If txtNumber2.Text = spnNumber2.Value num2 = spnNumber2.Value End Sub ' ============================= ' 2.5 Number #2 Text KeyPress Private Sub txtNumber2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) Select Case KeyAscii ' Positive integers only Case Asc("0") To Asc("9") Case Else KeyAscii = 0 End Select End Sub ' ============================= ' 2.6 Number #2 Text Change Private Sub txtNumber2_Change() num2 = Val(txtNumber2) spnNumber2.Value = num2 If optMultiply.Value = True Then Call multiply1 Else Call divide1 End If End Sub ' ============================= ' ### End Input frame controls ' ============================= '
3. Result frame control events
Code 3: Sub
txtResult_Change
procedure
' ============================= ' 3. Start Result frame controls ' ============================= Private Sub txtResult_Change() If Me.optMultiply Then txtResult.Text = txtResult.Text ElseIf Me.optDivide Then txtResult.Text = Format(txtResult.Text, "#,##0.000") End If End Sub ' ============================= ' ### End Result frame controls ' ============================= '
4. Output frame control events
Code 4:
' ============================= ' 4. Start Output frame controls ' ============================= ' 4.1 Output DropButtonClick Private Sub txtoutputRange_DropButtonClick() ' The click event for the ReduceStyleDropButton On Error Resume Next Set outRange = Application.InputBox("Select range", "xlf DemoRefText", _ ActiveCell.Address(), Type:=8) txtOutputRange.Text = outRange.Address If Not outRange Is Nothing Then cmdOutput.Enabled = True On Error GoTo 0 End Sub ' ============================= ' 4.2 Output Click Private Sub chkOutput_Click() If chkOutput = True Then lblOutput.Enabled = True txtOutputRange.Enabled = True 'cmdOutput.Enabled = True Else lblOutput.Enabled = False txtOutputRange.Enabled = False cmdOutput.Enabled = False End If End Sub ' ============================= ' ### End Output frame controls ' ============================= '
5. Calculation engine code
Code 5: Sub
multiply1
and Sub divide1
procedures
' ============================= ' 5. Start calculation engine ' ============================= ' 5.1 Multiply Private Sub multiply1() If txtNumber1.Text <> "" And txtNumber2.Text <> "" Then TxtResult.Text = num1 * num2 End If End Sub ' ============================= ' 5.2 Divide Private Sub divide1() If txtNumber1.Text <> "" And txtNumber2.Text <> "" Then If num2 = 0 Then MsgBox "Division by zero", vbCritical, "Warning" TxtResult.Text = "" Else TxtResult.Text = Application.Round(num1 / num2, 3) End If End If End Sub ' ============================= ' ### End calculation engine ' ============================= '
- Download: xlf-frmCalculator.xlsm [48 KB ]
- Development platform: Office 365 ProPlus - Excel 2016 MSO (16.0...) 64 bit
- Published: 20th May 2018
- Revised: Friday 24th of February 2023 - 02:38 PM, Pacific Time (PT)