hapintopereira 8/1/2016, 19:22
visto que não consigo enviar access completo, segue o código
Option Compare Database
Option Explicit
Public strOpr As String 'Hold + - / * Signs
Public dblVal1 As Double 'Hold First Entered Value
Public dblVal2 As Double 'Hold Second value after opretor singn hit
Public dblResult As Double 'Show result
Public IntTemp As Double 'Hold Key State
Const GetTemp = 1
Const RelTemp = 0
Private Sub cmd0_Click()
On Error Resume Next
If IntTemp = GetTemp Then
Me.lblDisplay.Caption = "0"
ElseIf Me.lblDisplay.Caption = "0." Then
Me.lblDisplay.Caption = Me.cmd0.Caption & "."
Else
Me.lblDisplay.Caption = Me.lblDisplay.Caption + Me.cmd0.Caption
'IntTemp = RelTemp
End If
' If Me.lblDisplay.Caption = "0." And IntTemp = GetTemp Then
' Me.lblDisplay.Caption = Me.cmd0.Caption
' Else
' Me.lblDisplay.Caption = Me.lblDisplay.Caption + Me.cmd0.Caption
' End If
End Sub
Private Sub cmd1_Click()
On Error Resume Next
If IntTemp = GetTemp Then
Me.lblDisplay.Caption = "0."
IntTemp = RelTemp
End If
If Me.lblDisplay.Caption = "0." Then
Me.lblDisplay.Caption = Me.cmd1.Caption
Else
Me.lblDisplay.Caption = Me.lblDisplay.Caption + Me.cmd1.Caption
End If
End Sub
Private Sub cmd2_Click()
On Error Resume Next
If IntTemp = GetTemp Then
Me.lblDisplay.Caption = "0."
IntTemp = RelTemp
End If
If Me.lblDisplay.Caption = "0." Then
Me.lblDisplay.Caption = Me.cmd2.Caption
Else
Me.lblDisplay.Caption = Me.lblDisplay.Caption + Me.cmd2.Caption
End If
End Sub
Private Sub cmd3_Click()
On Error Resume Next
If IntTemp = GetTemp Then
Me.lblDisplay.Caption = "0."
IntTemp = RelTemp
End If
If Me.lblDisplay.Caption = "0." Then
Me.lblDisplay.Caption = Me.cmd3.Caption
Else
Me.lblDisplay.Caption = Me.lblDisplay.Caption + Me.cmd3.Caption
End If
End Sub
Private Sub cmd4_Click()
On Error Resume Next
If IntTemp = GetTemp Then
Me.lblDisplay.Caption = "0."
IntTemp = RelTemp
End If
If Me.lblDisplay.Caption = "0." Then
Me.lblDisplay.Caption = Me.cmd4.Caption
Else
Me.lblDisplay.Caption = Me.lblDisplay.Caption + Me.cmd4.Caption
End If
End Sub
Private Sub cmd5_Click()
On Error Resume Next
If IntTemp = GetTemp Then
Me.lblDisplay.Caption = "0."
IntTemp = RelTemp
End If
If Me.lblDisplay.Caption = "0." Then
Me.lblDisplay.Caption = Me.cmd5.Caption
Else
Me.lblDisplay.Caption = Me.lblDisplay.Caption + Me.cmd5.Caption
End If
End Sub
Private Sub cmd6_Click()
On Error Resume Next
If IntTemp = GetTemp Then
Me.lblDisplay.Caption = "0."
IntTemp = RelTemp
End If
If Me.lblDisplay.Caption = "0." Then
Me.lblDisplay.Caption = Me.cmd6.Caption
Else
Me.lblDisplay.Caption = Me.lblDisplay.Caption + Me.cmd6.Caption
End If
End Sub
Private Sub cmd7_Click()
On Error Resume Next
If IntTemp = GetTemp Then
Me.lblDisplay.Caption = "0."
IntTemp = RelTemp
End If
If Me.lblDisplay.Caption = "0." Then
Me.lblDisplay.Caption = Me.cmd7.Caption
Else
Me.lblDisplay.Caption = Me.lblDisplay.Caption + Me.cmd7.Caption
End If
End Sub
Private Sub cmd8_Click()
On Error Resume Next
If IntTemp = GetTemp Then
Me.lblDisplay.Caption = "0."
IntTemp = RelTemp
End If
If Me.lblDisplay.Caption = "0." Then
Me.lblDisplay.Caption = Me.cmd8.Caption
Else
Me.lblDisplay.Caption = Me.lblDisplay.Caption + Me.cmd8.Caption
End If
End Sub
Private Sub cmd9_Click()
On Error Resume Next
If IntTemp = GetTemp Then
Me.lblDisplay.Caption = "0."
IntTemp = RelTemp
End If
If Me.lblDisplay.Caption = "0." Then
Me.lblDisplay.Caption = Me.cmd9.Caption
Else
Me.lblDisplay.Caption = Me.lblDisplay.Caption + Me.cmd9.Caption
End If
End Sub
Private Sub cmdAdd_Click()
On Error GoTo err_handler
dblVal1 = Me.lblDisplay.Caption
strOpr = Me.cmdAdd.Caption
Me.txtOpHolder.Value = "+"
IntTemp = GetTemp
Exit_Procedure:
On Error Resume Next
Exit Sub
err_handler:
Select Case Err.Number
Case 13
Resume Next
Case Else
MsgBox "Error No.: " & Err.Number & " " & "Error Description: " & Err.Description
End Select
End Sub
Private Sub cmdBackSpace_Click()
On Error Resume Next
If Me.lblDisplay.Caption = "0." Then
Exit Sub
ElseIf Len(Me.lblDisplay.Caption) > 1 Then
Me.lblDisplay.Caption = Left(Me.lblDisplay.Caption, Len(Me.lblDisplay.Caption) - 1)
Else
Me.lblDisplay.Caption = "0."
End If
End Sub
Private Sub cmdCe_Click()
Me.lblDisplay.Caption = "0."
End Sub
Private Sub cmdClear_Click()
On Error Resume Next
Me.lblDisplay.Caption = "0."
Me.txtOpHolder.Value = ""
dblVal1 = RelTemp
dblVal2 = RelTemp
dblResult = RelTemp
strOpr = ""
Me.txtPlusMinus.Value = ""
End Sub
Private Sub cmdDivide_Click()
On Error GoTo err_handler
dblVal1 = Me.lblDisplay.Caption
strOpr = Me.cmdDivide.Caption
Me.txtOpHolder.Value = "/"
IntTemp = GetTemp
Exit_Procedure:
On Error Resume Next
Exit Sub
err_handler:
Select Case Err.Number
Case 13
Resume Next
Case Else
MsgBox "Error No.: " & Err.Number & " " & "Error Description: " & Err.Description
End Select
End Sub
Private Sub cmdDot_Click()
On Error Resume Next
If IntTemp = GetTemp Then
Me.lblDisplay.Caption = "0."
IntTemp = RelTemp
End If
If Me.lblDisplay.Caption = "0." Then
Me.lblDisplay.Caption = Me.cmdDot.Caption
End If
If InStr(Me.lblDisplay.Caption, ".") >= 1 Then
Exit Sub
Else
Me.lblDisplay.Caption = Me.lblDisplay.Caption + Me.cmdDot.Caption
End If
End Sub
Private Sub cmdEquals_Click()
On Error GoTo err_handler
dblVal2 = Me.lblDisplay.Caption
If Me.lblDisplay.Caption = "0." Then
Exit Sub
End If
Select Case strOpr
Case "+"
dblResult = dblVal1 + dblVal2
Me.lblDisplay.Caption = dblResult
dblVal2 = dblResult
Case "-"
dblResult = dblVal1 - dblVal2
Me.lblDisplay.Caption = dblResult
dblVal2 = dblResult
Case "*"
dblResult = dblVal1 * dblVal2
Me.lblDisplay.Caption = dblResult
dblVal2 = dblResult
Case "/"
If dblVal2 = 0 Then
Me.lblDisplay.Caption = "Cannot divided by zero."
Exit Sub
Else
dblResult = dblVal1 / dblVal2
Me.lblDisplay.Caption = dblResult
dblVal2 = dblResult
End If
End Select
IntTemp = GetTemp
Exit_Procedure:
On Error Resume Next
Exit Sub
err_handler:
Select Case Err.Number
Case 13
Resume Next
Case Else
MsgBox "Error No.: " & Err.Number & " " & "Error Description: " & Err.Description
End Select
End Sub
Private Sub cmdMultiply_Click()
On Error GoTo err_handler
dblVal1 = Me.lblDisplay.Caption
strOpr = Me.cmdMultiply.Caption
Me.txtOpHolder.Value = "*"
IntTemp = GetTemp
Exit_Procedure:
On Error Resume Next
Exit Sub
err_handler:
Select Case Err.Number
Case 13
Resume Next
Case Else
MsgBox "Error No.: " & Err.Number & " " & "Error Description: " & Err.Description
End Select
End Sub
Private Sub cmdPercent_Click()
On Error GoTo err_handler
dblVal2 = Me.lblDisplay.Caption
Dim dblForPercent As Double
Me.txtPercent.Value = dblVal2
If Me.lblDisplay.Caption = "0." Then
Exit Sub
End If
Select Case strOpr
Case "+"
dblResult = dblVal1 * dblVal2 / 100
Me.lblDisplay.Caption = dblResult
dblVal2 = dblResult
Case "-"
dblResult = dblVal1 * dblVal2 / 100
Me.lblDisplay.Caption = dblResult
dblVal2 = dblResult
Case "*"
dblResult = dblVal1 * dblVal2 / 100
Me.lblDisplay.Caption = dblResult
dblVal2 = dblResult
Case "/"
dblResult = dblVal1 * dblVal2 / 100
Me.lblDisplay.Caption = dblResult
dblVal2 = dblResult
End Select
IntTemp = GetTemp
Exit_Procedure:
On Error Resume Next
Exit Sub
err_handler:
Select Case Err.Number
Case 13
Resume Next
Case Else
MsgBox "Error No.: " & Err.Number & " " & "Error Description: " & Err.Description
End Select
End Sub
Private Sub cmdPlusMinus_Click()
On Error GoTo err_handler
If Me.lblDisplay.Caption = "0." Then Exit Sub
Me.txtPlusMinus.Value = Me.lblDisplay.Caption
With Me.txtPlusMinus
Select Case .Value
Case Is < 0
.Value = .Value * -1
Me.lblDisplay.Caption = .Value
Case Is >= 0
.Value = .Value * -1
Me.lblDisplay.Caption = .Value
End Select
End With
Exit_Procedure:
On Error Resume Next
Exit Sub
err_handler:
Select Case Err.Number
Case 13
Resume Next
Case Else
MsgBox "Error No.: " & Err.Number & " " & "Error Description: " & Err.Description
End Select
End Sub
Private Sub cmdSubtract_Click()
On Error GoTo err_handler
dblVal1 = Me.lblDisplay.Caption
strOpr = Me.cmdSubtract.Caption
Me.txtOpHolder.Value = "-"
IntTemp = GetTemp
Exit_Procedure:
On Error Resume Next
Exit Sub
err_handler:
Select Case Err.Number
Case 13
Resume Next
Case Else
MsgBox "Error No.: " & Err.Number & " " & "Error Description: " & Err.Description
End Select
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
On Error Resume Next
Select Case Shift
Case 1
Select Case KeyCode
Case 56
cmdMultiply_Click
Case 187
cmdAdd_Click
Case 189
cmdSubtract_Click
Case 53
cmdPercent_Click
End Select
Case Else
Select Case KeyCode
Case vbKeyEscape
cmdClear_Click
Case vbKeyAdd
cmdAdd_Click
Case vbKeySubtract
cmdSubtract_Click
Case vbKeyDivide
cmdDivide_Click
Case vbKeyMultiply
cmdMultiply_Click
Case vbKeyDecimal, 190
cmdDot_Click
Case 13, 187
cmdEquals_Click
Case 113
cmdSelectCalc_Click
Case 8
If Me.lblDisplay.Caption = "0." Then
Exit Sub
ElseIf Len(Me.lblDisplay.Caption) > 1 Then
Me.lblDisplay.Caption = Left(Me.lblDisplay.Caption, Len(Me.lblDisplay.Caption) - 1)
Else
Me.lblDisplay.Caption = "0."
End If
Case vbKeyNumpad0, vbKey0
cmd0_Click
Case vbKeyNumpad1, vbKey1
cmd1_Click
Case vbKeyNumpad2, vbKey2
cmd2_Click
Case vbKeyNumpad3, vbKey3
cmd3_Click
Case vbKeyNumpad4, vbKey4
cmd4_Click
Case vbKeyNumpad5, vbKey5
cmd5_Click
Case vbKeyNumpad6, vbKey6
cmd6_Click
Case vbKeyNumpad7, vbKey7
cmd7_Click
Case vbKeyNumpad8, vbKey8
cmd8_Click
Case vbKeyNumpad9, vbKey9
cmd9_Click
End Select
End Select
KeyCode = 0
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
On Error Resume Next
KeyAscii = 0
End Sub
Private Sub Form_Load()
On Error Resume Next
Me.txtOpHolder.Value = ""
Me.lblDisplay.Caption = "0."
End Sub
Private Sub cmdSelectCalc_Click()
On Error Resume Next
TargetTextBox = Me.lblDisplay.Caption
TargetTextBox.SetFocus
DoCmd.Close acForm, Me.Name, acSaveNo
End Sub
apenas de salientar que no fim aparece cmdselectcalc, é relativo a um módulo, apenas abre um form com uma textbox e a partir da calculadora envia resultado.
se conseguir resolver a minha dúvida agradeço