Toepassing met Calculator - opzetje - wie helpt bij de afwerking?
In bijgaande toepassing vind je een formulier met 2 tekstvakken en een knop om de Calculator te starten (routine: cmdCalc_Click). Als de Calculator al open staat wordt die geactiveerd.
Om de cursor terug te zetten in het juiste tekstvak (txt) of keuzelijst (cbo) wordt de naam van het veld even opgeslagen (routine: cmdCalc_MouseMove).
De gebruiker maakt dan een rekensom of alleen een waarde in de Calculator. Als hij terugkeert op het formulier en de recordselector aanklikt, wordt de waarde in het veld gekopieerd ((routine: Form_Click). Het werkt, maar dit vind ik nog armoedig - moet beter kunnen. Iemand een idee?
Code:
--------------------------------------
Option Compare Database
Option Explicit
Dim dblRetVal As Double
Dim strFieldname As String
' -----------------------------------------------------------------------
Private Sub cmdCalc_Click()
On Error GoTo cmdCalc_Click_Err
' Activeert Calculator
AppActivate dblRetVal
cmdCalc_Click_Exit:
Exit Sub
cmdCalc_Click_Err:
Select Case Err.Number
Case 5
' Start Calculator
dblRetVal = Shell("CALC.EXE", vbNormalFocus)
Case Else
dblRetVal = 0
MsgBox Err.Description & " (" & Err.Number & ")"
Resume cmdCalc_Click_Exit
End Select
End Sub
' -----------------------------------------------------------------------
Private Sub cmdCalc_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim strCtrl As String
Dim strPrefix As String
strPrefix = "txt cbo "
strCtrl = Me.ActiveControl.Name
If InStr(1, strPrefix, Left$(strCtrl, 3)) > 0 Then
strFieldname = strCtrl
Me.lblCtrlActive.Caption = strFieldname
End If
End Sub
' -----------------------------------------------------------------------
Private Sub Form_Click()
On Error GoTo Form_GotFocus_Err
If dblRetVal <> 0 Then
AppActivate dblRetVal ' Activeert Calculator
SendKeys "^C" ' Kopieert het totaal naar het Klembord
SendKeys "%{F4}", True ' Verstuurt ALT+F4 om de Rekenmachine te sluiten.
dblRetVal = 0
' Zet cursor terug in het juiste veld
Me.Controls(strFieldname).SetFocus
DoCmd.RunCommand acCmdPaste ' Kopieert het totaal in het veld
End If
Form_GotFocus_Exit:
Exit Sub
Form_GotFocus_Err:
' Calculator is niet geopend of andere fout trad op
dblRetVal = 0
Resume Form_GotFocus_Exit
End Sub
--------------------------------------
