Super Shortcuts - Helen Bradleys

'********************************
'Place this in the module's code section '********************************

Sub currencyConverter()
      UserForm1.Show
End Sub

 

'********************************
'Place this in the userform's code section '********************************

Const msgText As String = "Your entry is either not a number or it is zero"
Const msgText2 As String = "Please enter a number and click a button to continue."
Const conversion As Single = 0.52
Public rate As Single

Private Sub UserForm_Initialize()
     
linefeed = Chr(13)
     prompttext = "The current conversion rate is" & Str(conversion)
     
prompttext = prompttext & linefeed & "Type a number to alter, or"
     prompttext = prompttext & linefeed & "Press Enter to leave as is."
     newconversion = InputBox(prompttext, "Conversion Rate", conversion)
     If IsNumeric(newconversion) And newconversion <> 0 Then
           rate = newconversion
     Else
           
rate = conversion
     End If
     
lblRate.Caption = Str(rate)
     tbValue.Text = 100
End Sub

Private Sub cmdAUS_Click()
     linefeed = Chr(13)
     
USamount = tbValue.Text
     If IsNumeric(USamount) And Val(USamount) <> 0 Then
           AUDamount = USamount / rate
           tbValue.Text = Int(100 * AUDamount + 0.5) / 100
     Else
           MsgBox msgText & linefeed & msgText2
           tbValue.Text = 100
           tbValue.SetFocus
     End If
End Sub

Private Sub cmdUS_Click()
     
linefeed = Chr(13)
     AUDamount = tbValue.Text
     If IsNumeric(AUDamount) And Val(AUDamount) <> 0 Then
           USamount = AUDamount * rate
           tbValue.Text = Int(100 * USamount + 0.5) / 100
     Else
           
MsgBox msgText & linefeed & msgText2
           tbValue.Text = 100
           
tbValue.SetFocus
     End If
End Sub

Private Sub cmdPaste_Click()
     ActiveCell.Value = tbValue
End Sub

Private Sub cmdExit_Click()
     Unload Me
     End
End Sub

Private Sub tbValue_Enter()
     
tbValue.SelStart = 0
     tbValue.SelLength = Len(tbValue)
End Sub

 
download a copy of currency code
/currency_code.txt

download Currency.xls
/Currency.xls

 

⌐ Australian Consolidated Press 2000. All rights reserved.