Code:
Option Explicit
Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Const VK_SNAPSHOT = 44
Const VK_LMENU = 164
Const KEYEVENTF_KEYUP = 2
Const KEYEVENTF_EXTENDEDKEY = 1
Private Sub btnCalculate_Click()
' variables
Dim EnhancementRate As Single, EnhancedPremium As Single, Enhancement As Single
Dim BreakRate As Single, BreakValue As Single, BreakTotal As Single
Dim IdentityTotal As Single
Dim Tier1 As Single, Tier2 As Single, Tier3 As Single, DataTotal As Single
Dim FloodRate As Single, FloodValue As Single, FloodTotal As Single
Dim MisconductRate As Single, MisconductPremium As Single, MisconductTotal As Single
'connecting textboxes and lables to the variables, and calculations
EnhancementRate = Val(txtEnhancementRate.Text)
EnhancedPremium = Val(txtEnhancementPremium.Text)
Enhancement = EnhancementRate * EnhancedPremium
BreakRate = Val(txtBreakRate.Text)
BreakValue = Val(txtBreakValue.Text)
BreakTotal = (BreakRate * BreakValue) / 100
IdentityTotal = 12
Tier1 = 89
Tier2 = 119
Tier3 = 148
If cbTier.Text = "Tier 1" Then
DataTotal = Tier1
ElseIf cbTier.Text = "Tier 2" Then
DataTotal = Tier2
ElseIf cbTier.Text = "Tier 3" Then
DataTotal = Tier3
End If
FloodRate = Val(txtFloodRate.Text)
FloodValue = Val(txtFloodValue.Text)
FloodTotal = (FloodRate * FloodValue) / 100
MisconductRate = Val(txtMisconductRate.Text)
MisconductPremium = Val(txtMisconductPremium.Text)
MisconductTotal = MisconductRate * MisconductPremium
'because of the option to select whether you need Flood or Sexual Misconduct coverage, data will be outputted with an if statement.
If lblFloodTotal.Enabled = False And lblMisconductTotal.Enabled = False And lblIdentityTotal.Enabled = False Then
lblEnhancementTotal.Caption = FormatCurrency(Round(Enhancement))
lblBreakTotal.Caption = FormatCurrency(Round(BreakTotal))
lblDataTotal.Caption = FormatCurrency(Round(DataTotal))
ElseIf lblFloodTotal.Enabled = True And lblMisconductTotal.Enabled = False And lblIdentityTotal.Enabled = False Then
lblEnhancementTotal.Caption = FormatCurrency(Round(Enhancement))
lblBreakTotal.Caption = FormatCurrency(Round(BreakTotal))
lblDataTotal.Caption = FormatCurrency(Round(DataTotal))
lblFloodTotal.Caption = FormatCurrency(Round(FloodTotal))
ElseIf lblFloodTotal.Enabled = False And lblMisconductTotal.Enabled = True And lblIdentityTotal.Enabled = False Then
lblEnhancementTotal.Caption = FormatCurrency(Round(Enhancement))
lblBreakTotal.Caption = FormatCurrency(Round(BreakTotal))
lblDataTotal.Caption = FormatCurrency(Round(DataTotal))
lblMisconductTotal.Caption = FormatCurrency(Round(MisconductTotal))
ElseIf lblFloodTotal.Enabled = False And lblMisconductTotal.Enabled = True And lblIdentityTotal.Enabled = True Then
lblEnhancementTotal.Caption = FormatCurrency(Round(Enhancement))
lblBreakTotal.Caption = FormatCurrency(Round(BreakTotal))
lblIdentityTotal.Caption = FormatCurrency(Round(IdentityTotal))
lblDataTotal.Caption = FormatCurrency(Round(DataTotal))
Else
lblEnhancementTotal.Caption = FormatCurrency(Round(Enhancement))
lblBreakTotal.Caption = FormatCurrency(Round(BreakTotal))
lblIdentityTotal.Caption = FormatCurrency(Round(IdentityTotal))
lblDataTotal.Caption = FormatCurrency(Round(DataTotal))
lblFloodTotal.Caption = FormatCurrency(Round(FloodTotal))
lblMisconductTotal.Caption = FormatCurrency(Round(MisconductTotal))
End If
End Sub
Private Sub btnClear_Click()
'this allows the form to be cleared
txtEnhancementRate.Text = ""
txtEnhancementPremium.Text = ""
lblEnhancementTotal.Caption = ""
txtBreakRate.Text = ""
txtBreakValue.Text = ""
lblBreakTotal.Caption = ""
lblIdentityTotal.Caption = ""
lblDataTotal.Caption = ""
txtFloodRate.Text = ""
txtFloodValue.Text = ""
lblFloodTotal.Caption = ""
txtMisconductRate.Text = ""
txtMisconductPremium.Text = ""
lblMisconductTotal.Caption = ""
End Sub
Private Sub btnClose_Click()
Me.Hide
End Sub
Private Sub btnPrint_Click()
DoEvents
Application.ScreenUpdating = False
keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
DoEvents
Workbooks.Add
Application.Wait Now + TimeValue("00:00:01")
ActiveSheet.PasteSpecial Format:="Bitmap", Link:=False, _
DisplayAsIcon:=False
ActiveSheet.Range("A1").Select
'added to force landscape
ActiveSheet.PageSetup.Orientation = xlLandscape
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
'// One or more properties may not be available
.PrintQuality = 300
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1
ActiveWorkbook.Close False
Application.ScreenUpdating = True
End Sub
Private Sub btnSave_Click()
'This part of the code allows the form to export data to excel. This is necessary if you want to print the data from the form.
Dim wb As Workbook
Dim wks As Worksheet
Dim myRNG As Range
Dim mActiveRow As Long
Set wb = ThisWorkbook
Set wks = wb.Sheets("sheet2")
Set myRNG = wks.Range("A6")
' because we have the option to select what we want to calculate, we have different possiblites when it comes to
'saving. each level of "if" saves a different possiblity.
With myRNG
If lblIdentityTotal.Enabled = False And lblFloodTotal.Enabled = False And lblMisconduct.Enabled = False Then
.Offset(1, 0).Value = "Enhancement Premium: " & FormatCurrency(txtEnhancementPremium.Value)
.Offset(2, 0).Value = "Enhancement: " & FormatCurrency(Val(lblEnhancementTotal.Caption))
.Offset(3, 0).Value = "Break Down Property Value: " & FormatCurrency(txtBreakValue.Text)
.Offset(4, 0).Value = "Break Down: " & FormatCurrency(lblBreakTotal.Caption)
.Offset(5, 0).Value = "Data Compromise: " & FormatCurrency(Val(lblDataTotal.Caption))
ElseIf lblIdentityTotal.Enabled = True And lblFloodTotal.Enabled = False And lblMisconduct.Enabled = False Then
.Offset(6, 0).Value = "Enhancement Premium: " & FormatCurrency(Val(txtEnhancementPremium.Text))
.Offset(7, 0).Value = "Enhancement: " & FormatCurrency(Val(lblEnhancementTotal.Caption))
.Offset(8, 0).Value = "Break Down Property Value: " & FormatCurrency(txtBreakValue.Text)
.Offset(9, 0).Value = "Break Down: " & FormatCurrency(lblBreakTotal.Caption)
.Offset(10, 0).Value = "Identity Recovery: " & FormatCurrency(Val(lblIdentityTotal.Caption))
.Offset(11, 0).Value = "Data Compromise: " & FormatCurrency(Val(lblDataTotal.Caption))
ElseIf lblIdentityTotal.Enabled = False And lblFloodTotal.Enabled = True And lblMisconduct.Enabled = False Then
.Offset(12, 0).Value = "Enhancement Premium: " & FormatCurrency(Val(txtEnhancementPremium.Text))
.Offset(13, 0).Value = "Enhancement: " & FormatCurrency(Val(lblEnhancementTotal.Caption))
.Offset(14, 0).Value = "Break Down Property Value: " & FormatCurrency(txtBreakValue.Text)
.Offset(15, 0).Value = "Break Down: " & FormatCurrency(lblBreakTotal.Caption)
.Offset(16, 0).Value = "Data Compromise: " & FormatCurrency(Val(lblDataTotal.Caption))
.Offset(17, 0).Value = "Flood Property Value: " & FormatCurrency(txtFloodValue.Text)
.Offset(18, 0).Value = "Flood: " & FormatCurrency(Val(lblFloodTotal.Caption))
ElseIf lblIdentityTotal.Enabled = False And lblFloodTotal.Enabled = False And lblMisconduct.Enabled = True Then
.Offset(19, 0).Value = "Enhancement Premium: " & FormatCurrency(Val(txtEnhancementPremium.Text))
.Offset(20, 0).Value = "Enhancement: " & FormatCurrency(Val(lblEnhancementTotal.Caption))
.Offset(21, 0).Value = "Break Down Property Value: " & FormatCurrency(txtBreakValue.Text)
.Offset(22, 0).Value = "Break Down: " & FormatCurrency(lblBreakTotal.Caption)
.Offset(23, 0).Value = "Data Compromise: " & FormatCurrency(Val(lblDataTotal.Caption))
.Offset(24, 0).Value = "Abuse Premium: " & FormatCurrency(Val(txtMisconductPremium.Text))
.Offset(25, 0).Value = "Abuse: " & FormatCurrency(lblMisconduct.Caption)
ElseIf lblIdentityTotal.Enabled = True And lblFloodTotal.Enabled = True And lblMisconduct.Enabled = False Then
.Offset(26, 0).Value = "Enhancement Premium: " & FormatCurrency(Val(txtEnhancementPremium.Text))
.Offset(27, 0).Value = "Enhancement: " & FormatCurrency(Val(lblEnhancementTotal.Caption))
.Offset(28, 0).Value = "Break Down Property Value: " & FormatCurrency(txtBreakValue.Text)
.Offset(29, 0).Value = "Break Down: " & FormatCurrency(lblBreakTotal.Caption)
.Offset(30, 0).Value = "Identity Recovery: " & FormatCurrency(Val(lblIdentityTotal.Caption))
.Offset(31, 0).Value = "Data Compromise: " & FormatCurrency(Val(lblDataTotal.Caption))
.Offset(32, 0).Value = "Flood Property Value: " & FormatCurrency(txtFloodValue.Text)
.Offset(33, 0).Value = "Flood: " & FormatCurrency(Val(lblFloodTotal.Caption))
ElseIf lblIdentityTotal.Enabled = True And lblFloodTotal.Enabled = False And lblMisconduct.Enabled = True Then
.Offset(34, 0).Value = "Enhancement Premium: " & FormatCurrency(Val(txtEnhancementPremium.Text))
.Offset(35, 0).Value = "Enhancement: " & FormatCurrency(Val(lblEnhancementTotal.Caption))
.Offset(36, 0).Value = "Break Down Property Value: " & FormatCurrency(txtBreakValue.Text)
.Offset(37, 0).Value = "Break Down: " & FormatCurrency(lblBreakTotal.Caption)
.Offset(38, 0).Value = "Identity Recovery: " & FormatCurrency(Val(lblIdentityTotal.Caption))
.Offset(39, 0).Value = "Data Compromise: " & FormatCurrency(Val(lblDataTotal.Caption))
.Offset(40, 0).Value = "Abuse Premium: " & FormatCurrency(Val(txtMisconductPremium.Text))
.Offset(41, 0).Value = "Abuse: " & FormatCurrency(lblMisconduct.Caption)
ElseIf lblIdentityTotal.Enabled = False And lblFloodTotal.Enabled = True And lblMisconduct.Enabled = True Then
.Offset(42, 0).Value = "Enhancement Premium: " & FormatCurrency(Val(txtEnhancementPremium.Text))
.Offset(43, 0).Value = "Enhancement: " & FormatCurrency(Val(lblEnhancementTotal.Caption))
.Offset(44, 0).Value = "Break Down Property Value: " & FormatCurrency(txtBreakValue.Text)
.Offset(45, 0).Value = "Break Down: " & FormatCurrency(lblBreakTotal.Caption)
.Offset(46, 0).Value = "Data Compromise: " & FormatCurrency(Val(lblDataTotal.Caption))
.Offset(47, 0).Value = "Flood Property Value: " & FormatCurrency(txtFloodValue.Text)
.Offset(48, 0).Value = "Flood: " & FormatCurrency(Val(lblFloodTotal.Caption))
.Offset(49, 0).Value = "Abuse Premium: " & FormatCurrency(Val(txtMisconductPremium.Text))
.Offset(50, 0).Value = "Abuse: " & FormatCurrency(lblMisconduct.Caption)
Else
.Offset(51, 0).Value = "Enhancement Premium: " & FormatCurrency(Val(txtEnhancementPremium.Text))
.Offset(52, 0).Value = "Enhancement: " & FormatCurrency(Val(lblEnhancementTotal.Caption))
.Offset(53, 0).Value = "Break Down Property Value: " & FormatCurrency(txtBreakValue.Text)
.Offset(54, 0).Value = "Break Down: " & FormatCurrency(lblBreakTotal.Caption)
.Offset(55, 0).Value = "Identity Recovery: " & FormatCurrency(Val(lblIdentityTotal.Caption))
.Offset(56, 0).Value = "Data Compromise: " & FormatCurrency(Val(lblDataTotal.Caption))
.Offset(57, 0).Value = "Flood Property Value: " & FormatCurrency(txtFloodValue.Text)
.Offset(58, 0).Value = "Flood: " & FormatCurrency(Val(lblFloodTotal.Caption))
.Offset(59, 0).Value = "Abuse Premium: " & FormatCurrency(Val(txtMisconductPremium.Text))
.Offset(60, 0).Value = "Abuse: " & FormatCurrency(lblMisconduct.Caption)
End If
End With
End Sub
I cannot fit my full code, so I chopped it down to its break point (see hi-lighted portion).