1) Open MS Excel
2) ALT+F11 to open VBA code editor
3) Add new class (menu Insert->Class module) and change it name to: ClsCalcTemp
4) Copy and paste code below:
Option Explicit
Private mdblCelsius As Double
Private mdblFahrenheit As Double
Private Sub Class_Initialize()
Celsius = 0
Fahrenheit = 0
End Sub
Public Property Let Celsius(dCelcius As Double)
mdblCelsius = dCelcius
End Property
Public Property Get Celsius() As Double
Celsius = mdblCelsius
End Property
Public Property Let Fahrenheit(dFahrenheit As Double)
mdblFahrenheit = dFahrenheit
End Property
Public Property Get Fahrenheit() As Double
Fahrenheit = mdblFahrenheit
End Property
Public Function F2C(ByVal dFahrenheit As Double) As Double
mdblFahrenheit = dFahrenheit
mdblCelsius = ((dFahrenheit * 9) / 5) + 32
F2C = mdblCelsius
End Function
Public Function C2F(ByVal dCelsius As Double) As Double
mdblCelsius = dCelsius
mdblFahrenheit = ((dCelsius - 32) * 5) / 9
C2F = mdblFahrenheit
End Function
Private Sub Class_Terminate()
mdblCelsius = 0
mdblFahrenheit = 0
End Sub
5) Now, insert new UserForm (menu Insert->UserForm) and change it name to: CalcTempFrm
6) Insert controls:
- Frame /set property Caption:=Choose option/,
- ListBox (on he frame; this could be our option group) /set property Name:=LstOptTemp/ ,
- Label (below Frame) /set property Caption:=Temperature/,
- TextBox (on the right side of Label) /set property Name:=TxtTemperature/
- Label (below Textbox) /set property Name:=LblResult/
7) Copy and paste code below:
Option Explicit
Dim oTCalc As New ClsCalcTemp
Private Sub UserForm_Initialize()
'add options
Me.LstOptTemp.AddItem "Celsius -> Fahrenheit"
Me.LstOptTemp.AddItem "Fahrenheit -> Celsius"
End Sub
Private Sub CmdCalculate_Click()
Dim iOpt As Integer, dblTemperature As Double, dblResult As Double
On Error GoTo Err_CmdCalculate_Click
iOpt = Me.LstOptTemp.ListIndex
dblTemperature = CDbl(Me.TxtTemperature)
Select Case iOpt
Case -1
MsgBox "Select option!", vbInformation, "Message..."
Case 0
dblResult = oTCalc.C2F(dblTemperature)
Case 1
dblResult = oTCalc.F2C(dblTemperature)
End Select
Exit_CmdCalculate_Click:
Me.LblResult.Caption = "Result: " & dblResult
Exit Sub
Err_CmdCalculate_Click:
Select Case Err.Number
Case 13
MsgBox "Enter correct value!", vbInformation, "Error!"
Me.TxtTemperature.SetFocus
Case Else
MsgBox Err.Description, vbExclamation, "Error - " & Err.Number
End Select
dblResult = 0
Resume Exit_CmdCalculate_Click
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Set oTCalc = Nothing
End Sub
Run UserForm (F5) and be happy with your custom control and class.