Reputation:
I got this code from a friend and I actually never programmed Access apps.
Well, every time I click a button, I get an error like this:
Runtime error 2683 - There is no object in this control
This Access app was written back in 2003 and had some calendar showing. Now it just shows a blank white field.
When I click on Debug
on the error window it shows me the code.
Form_Abrechnungen.Tage.Value = Form_Abrechnungen.ActiveXCtl22.Value - Form_Abrechnungen.ActiveXCtl28.Value
Before this access app could run I had to copy this mscal.ocx file in my C:\Windows\System32
.
I've read that the new versions of Office don't support this anymore and I should use the native datepicker.
But I don't really know what to do since this is my first time programming access.
Here is the code that shows up when I click on debug:
Option Compare Database
Option Explicit
Private Sub ActiveXCtl22_Enter()
Form_Abrechnungen.Tage.Value = Form_Abrechnungen.ActiveXCtl22.Value - Form_Abrechnungen.ActiveXCtl28.Value
End Sub
Private Sub ActiveXCtl22_Exit(Cancel As Integer)
Form_Abrechnungen.Tage.Value = Form_Abrechnungen.ActiveXCtl22.Value - Form_Abrechnungen.ActiveXCtl28.Value
End Sub
Private Sub ActiveXCtl22_Updated(Code As Integer)
Form_Abrechnungen.Tage.Value = Form_Abrechnungen.ActiveXCtl22.Value - Form_Abrechnungen.ActiveXCtl28.Value
End Sub
Private Sub ActiveXCtl28_Enter()
Form_Abrechnungen.Tage.Value = Form_Abrechnungen.ActiveXCtl22.Value - Form_Abrechnungen.ActiveXCtl28.Value
End Sub
Private Sub ActiveXCtl28_Exit(Cancel As Integer)
Form_Abrechnungen.Tage.Value = Form_Abrechnungen.ActiveXCtl22.Value - Form_Abrechnungen.ActiveXCtl28.Value
End Sub
Private Sub ActiveXCtl28_Updated(Code As Integer)
Form_Abrechnungen.Tage.Value = Form_Abrechnungen.ActiveXCtl22.Value - Form_Abrechnungen.ActiveXCtl28.Value
End Sub
Private Sub Befehl161_Click()
Dim Days As Integer
Days = Form_Abrechnungen.ActiveXCtl22.Value - Form_Abrechnungen.ActiveXCtl28.Value
Form_Abrechnungen.Tage.Value = Days
If ErwAnz.Value > 0 Then ErwNacht.Value = Days
If KindAnz.Value > 0 Then KindNacht.Value = Days
If BhAnz.Value > 0 Then BhNacht.Value = Days
If HundAnz.Value > 0 Then HundNacht.Value = Days
If pAnz.Value > 0 Then pNacht.Value = Days
If ZeltAnz.Value > 0 Then ZeltNacht.Value = Days
If CaraAnz.Value > 0 Then CaraNacht.Value = Days
If WmAnz.Value > 0 Then WmNacht.Value = Days
If ParAnz.Value > 0 Then ParNacht.Value = Days
If sAnz.Value > 0 Then sNacht.Value = Days
If KurAnz.Value > 0 Then KurNacht.Value = Days
If ZeltkleinAnz.Value > 0 Then ZeltkleinNacht.Value = Days
If AbfallAnz.Value > 0 Then AbfallNacht.Value = Days
If Gas5Anz.Value > 0 Then Gas5Nacht.Value = Days
If Gas11Anz.Value > 0 Then Gas11Nacht.Value = Days
If Mw1Anz.Value > 0 Then Mw1Nacht.Value = Days
If Mw2Anz.Value > 0 Then Mw2Nacht.Value = Days
If Mw3Anz.Value > 0 Then Mw3Nacht.Value = Days
If ReinigAnz.Value > 0 Then ReinigNacht.Value = Days
End Sub
Private Sub Befehl165_Click()
Form_KundeErfassen.AllowEdits = False
End Sub
Private Sub Befehl166_Click()
Form_KundeErfassen.AllowEdits = True
End Sub
Private Sub Befehl175_Click()
Me.AllowEdits = True
'Me.DataEntry = True
Total.BackColor = 16777215 'Weiss
ReadOnly.Value = False
CheckDoNotSave.Value = False
Me.Refresh
End Sub
Private Sub BhA_LostFocus()
Module1.CALC
End Sub
Private Sub BhAnz_LostFocus()
Module1.CALC
End Sub
Private Sub BhNacht_LostFocus()
Module1.CALC
End Sub
Sub CommandCalc_Click()
Module1.CALC
End Sub
Private Sub CheckMitglRab_AfterUpdate()
Dim MRabatt As Integer
MRabatt = Module1.GetDefaultVal("MitglRabatt")
If CheckMitglRab.Value Then
If ErwNacht.Value > 0 Then ErwA.Value = Module1.GetDefaultVal("Erw") * (100 - MRabatt) / 100
If KindNacht.Value > 0 Then KindA.Value = Module1.GetDefaultVal("Kind") * (100 - MRabatt) / 100
KindComment.Value = "inkl. Rabatt " & MRabatt & " %"
ErwComment.Value = "inkl. Rabatt " & MRabatt & " %"
Module1.CALC
End If
If Not CheckMitglRab.Value Then
If ErwNacht.Value > 0 Then ErwA.Value = Module1.GetDefaultVal("Erw")
If KindNacht.Value > 0 Then KindA.Value = Module1.GetDefaultVal("Kind")
KindComment.Value = " "
ErwComment.Value = " "
Module1.CALC
End If
End Sub
Private Sub CommandGOTOKunde_Click()
Dim FkKunde As Integer
Form_Abrechnungen.TextFKey.SetFocus
FkKunde = Form_Abrechnungen.TextFKey.Text
If CheckDoNotSave.Value Then
If Me.Dirty Then
Me.Undo
'MsgBox ("Keine Speicherung m�glich!")
End If
DoCmd.Close
Else
DoCmd.Close
End If
DoCmd.OpenForm "KundeErfassen"
Form_KundeErfassen.IDBox.SetFocus
DoCmd.FindRecord FkKunde, acEntire, , acUp, , acCurrent
If Form_KundeErfassen.Visible Then
'Form_KundeErfassen.Requery
Form_KundeErfassen.Refresh
Else
MsgBox "Error: Form seems to be Invisible! 24"
End If
End Sub
Private Sub CommandPreise_Click()
'Clear Comment may rabatt
KindComment.Value = " "
ErwComment.Value = " "
CheckMitglRab.Value = False
'Set Prices
If ErwNacht.Value > 0 Then ErwA.Value = Module1.GetDefaultVal("Erw")
If KindNacht.Value > 0 Then KindA.Value = Module1.GetDefaultVal("Kind")
If BhNacht.Value > 0 Then BhA.Value = Module1.GetDefaultVal("Bh")
If HundNacht.Value > 0 Then HundA.Value = Module1.GetDefaultVal("Hund")
If pNacht.Value > 0 Then pA.Value = Module1.GetDefaultVal("p")
If ZeltNacht.Value > 0 Then ZeltA.Value = Module1.GetDefaultVal("Zelt")
If CaraNacht.Value > 0 Then CaraA.Value = Module1.GetDefaultVal("Cara")
If WmNacht.Value > 0 Then WmA.Value = Module1.GetDefaultVal("Wm")
If ParNacht.Value > 0 Then ParA.Value = Module1.GetDefaultVal("Par")
If sNacht.Value > 0 Then sA.Value = Module1.GetDefaultVal("s")
If KurNacht.Value > 0 Then KurA.Value = Module1.GetDefaultVal("Kur")
If ZeltkleinNacht.Value > 0 Then ZeltkleinA.Value = Module1.GetDefaultVal("Zeltklein")
If AbfallNacht.Value > 0 Then AbfallA.Value = Module1.GetDefaultVal("Abfall")
If Gas5Nacht.Value > 0 Then Gas5A.Value = Module1.GetDefaultVal("GasP5kg")
If Gas11Nacht.Value > 0 Then Gas11A.Value = Module1.GetDefaultVal("GasP11kg")
If Mw1Nacht.Value > 0 Then Mw1A.Value = Module1.GetDefaultVal("Mw1")
If Mw2Nacht.Value > 0 Then Mw2A.Value = Module1.GetDefaultVal("Mw2")
If Mw3Nacht.Value > 0 Then Mw3A.Value = Module1.GetDefaultVal("Mw3")
If ReinigNacht.Value > 0 Then ReinigA.Value = Module1.GetDefaultVal("Reinig")
TextBoxMWSTSatz.Value = Module1.GetDefaultVal("MWST")
TextMWSTnr.Value = Module1.GetDefaultVal("MWSTNummer")
Module1.CALC
End Sub
Private Sub ErwA_LostFocus()
Module1.CALC
End Sub
Private Sub ErwAnz_Change()
Module1.CALC
End Sub
Sub ErwAnz_LostFocus()
Module1.CALC
End Sub
Private Sub ErwNacht_LostFocus()
Module1.CALC
End Sub
Private Sub Form_Current()
If ReadOnly.Value Then
CheckDoNotSave.Value = True
Me.AllowEdits = False
'Me.DataEntry = False
Total.BackColor = 12632256 'Grau
Else
CheckDoNotSave.Value = False
Me.AllowEdits = True
'Me.DataEntry = True
Total.BackColor = 16777215 'Weiss
End If
If Bezahlt.Value = "Bezahlt" Then
ToggleBezahlt.ForeColor = 32768
ToggleBezahlt.Caption = "Bezahlt"
Else
Bezahlt.Value = "Offen"
ToggleBezahlt.ForeColor = 255
ToggleBezahlt.Caption = "Cr�dit"
End If
Module1.CALC
End Sub
Private Sub Form_Load()
'Form_Abrechnungen.ParcelleNr.SetFocus
Form_Abrechnungen.ActiveXCtl28.SetFocus
Form_Abrechnungen.ActiveXCtl28.Value = Date
Form_Abrechnungen.ActiveXCtl22.SetFocus
Form_Abrechnungen.ActiveXCtl22.Value = Date + 1
Form_Abrechnungen.ActiveXCtl22.SetFocus
End Sub
Private Sub ToggleBezahlt_Click()
If CheckDoNotSave.Value Then
MsgBox ("Datensatz Gesperrt!")
Else
'If ToggleBezahlt.Value = "-1" Then
If Bezahlt.Value <> "Bezahlt" Then
Bezahlt.Value = "Bezahlt"
ToggleBezahlt.ForeColor = 32768
ToggleBezahlt.Caption = "Bezahlt"
CheckReadOnly.Value = True
DatumBezahlt.Value = Date
TextBezahlt.Requery
Total.Locked = True
'Form_Abrechnungen.Refresh
Else
Bezahlt.Value = "Offen"
ToggleBezahlt.ForeColor = 255
ToggleBezahlt.Caption = "Cr�dit"
'ReadOnly bleibt unver�ndert!
TextBezahlt.Requery
DatumBezahlt.Value = ""
Total.Locked = False
'Form_Abrechnungen.Refresh
End If
End If
End Sub
Private Sub Command62_Click()
On Error GoTo Err_Command62_Click
DoCmd.DoMenuItem acFormBar, acRecordsMenu, 5, , acMenuVer70
Exit_Command62_Click:
Exit Sub
Err_Command62_Click:
MsgBox Err.Description
Resume Exit_Command62_Click
End Sub
Private Sub Command68_Click()
On Error GoTo Err_Command68_Click
DoCmd.FindRecord 4, acEntire, , acUp, , acCurrent
Exit_Command68_Click:
Exit Sub
Err_Command68_Click:
MsgBox Err.Description
Resume Exit_Command68_Click
End Sub
Private Sub Command71_Click()
On Error GoTo Err_Command71_Click
DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 6, , acMenuVer70
Exit_Command71_Click:
Exit Sub
Err_Command71_Click:
MsgBox Err.Description
Resume Exit_Command71_Click
End Sub
Private Sub Total_AfterUpdate()
Dim HKur As Currency
Dim HDepot As Currency
Dim i As Integer
Dim fTotal As Currency
HKur = 0
HDepot = 0
If KurCost.Value <> 0 Then HKur = KurCost.Value
If Depot.Value <> 0 Then HDepot = Depot.Value
fTotal = Total.Value
Rabatt.Value = 0
Module1.CALC
i = 10 * (Subtotal.Value - ((fTotal - HKur + HDepot) / 100 * 100))
Rabatt.Value = i / 10
MsgBox "Das ergiebt einen Rabatt von Fr. " & Rabatt.Value, vbInformation, "Sie gew�hren Rabatt"
Module1.CALC
End Sub
Private Sub Total_Click()
Module1.CALC
End Sub
Private Sub Total_DblClick(Cancel As Integer)
Module1.CALC
End Sub
Private Sub Command95_Click()
On Error GoTo Err_Command95_Click
Dim stDocName As String
stDocName = "ReportAbrechnung"
DoCmd.OpenReport stDocName, acViewNormal
Exit_Command95_Click:
Exit Sub
Err_Command95_Click:
MsgBox Err.Description
Resume Exit_Command95_Click
End Sub
Private Sub Command96_Click()
On Error GoTo Err_Command96_Click
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
Exit_Command96_Click:
Exit Sub
Err_Command96_Click:
MsgBox Err.Description
Resume Exit_Command96_Click
End Sub
Private Sub Command97_Click()
Form_Abrechnungen.Tage.Value = Form_Abrechnungen.ActiveXCtl22.Value - Form_Abrechnungen.ActiveXCtl28.Value
End Sub
Private Sub Befehl155_Click()
On Error GoTo Err_Befehl155_Click
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
Exit_Befehl155_Click:
Exit Sub
Err_Befehl155_Click:
MsgBox Err.Description
Resume Exit_Befehl155_Click
End Sub
Private Sub Befehl158_Click()
On Error GoTo Err_Befehl158_Click
Dim stDocName As String
stDocName = "Bericht1"
DoCmd.OpenReport stDocName, acNormal
Exit_Befehl158_Click:
Exit Sub
Err_Befehl158_Click:
MsgBox Err.Description
Resume Exit_Befehl158_Click
End Sub
Private Sub Befehl160_Click()
On Error GoTo Err_Befehl160_Click
Screen.PreviousControl.SetFocus
DoCmd.DoMenuItem acFormBar, acEditMenu, 10, , acMenuVer70
Exit_Befehl160_Click:
Exit Sub
Err_Befehl160_Click:
MsgBox Err.Description
Resume Exit_Befehl160_Click
End Sub
Private Sub Befehl162_Click()
On Error GoTo Err_Befehl162_Click
Dim FkKunde As Integer
Form_Abrechnungen.TextFKey.SetFocus
FkKunde = Form_Abrechnungen.TextFKey.Text
If CheckDoNotSave.Value Then
If Me.Dirty Then
Me.Undo
'MsgBox ("Keine Speicherung m�glich!")
End If
DoCmd.Close
Else
DoCmd.Close
End If
DoCmd.OpenForm "KundeErfassen"
Form_KundeErfassen.IDBox.SetFocus
DoCmd.FindRecord FkKunde, acEntire, , acUp, , acCurrent
If Form_KundeErfassen.Visible Then
'Form_KundeErfassen.Requery
Form_KundeErfassen.Refresh
Else
MsgBox "Error: Form seems to be Invisible! 23"
End If
Exit_Befehl162_Click:
Exit Sub
Err_Befehl162_Click:
MsgBox "Error 162"
MsgBox Err.Description
Resume Exit_Befehl162_Click
End Sub
Private Sub Befehl163_Click()
On Error GoTo Err_Befehl163_Click
Screen.PreviousControl.SetFocus
DoCmd.DoMenuItem acFormBar, acEditMenu, 10, , acMenuVer70
Exit_Befehl163_Click:
Exit Sub
Err_Befehl163_Click:
MsgBox Err.Description
Resume Exit_Befehl163_Click
End Sub
Private Sub CommandTolal_Click()
On Error GoTo Err_CommandTolal_Click
Module1.CALC
Exit_CommandTolal_Click:
Exit Sub
Err_CommandTolal_Click:
MsgBox Err.Description
Resume Exit_CommandTolal_Click
End Sub
Private Sub Befehl176_Click()
On Error GoTo Err_Befehl176_Click
If ReadOnly.Value Then
If Me.Dirty Then
Me.Undo
MsgBox ("Keine Speicherung m�glich!")
End If
DoCmd.Close
Else
DoCmd.Close
End If
Exit_Befehl176_Click:
Exit Sub
Err_Befehl176_Click:
MsgBox Err.Description
Resume Exit_Befehl176_Click
End Sub
Upvotes: 0
Views: 1174
Reputation: 55856
I've read that the new versions of Office don't support this anymore and I should use the native datepicker.
That is correct.
But I don't really know what to do since this is my first time programming access.
There are alternatives to look up, if the native datepicker doesn't fit the purpose, but without some experience in VBA, it will not be easy to implement. You should team up with someone who knows VBA and Access.
Upvotes: 2