user11662911
user11662911

Reputation:

Access error 2683 - There is no object in this control

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

Answers (1)

Gustav
Gustav

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

Related Questions