时间戳

首页 > 解决方案 > 访问错误 2683 - 此控件中没有对象

vba - 访问错误 2683 - 此控件中没有对象

问题描述

我从朋友那里得到了这段代码，实际上我从未编写过 Access 应用程序。

好吧，每次我点击一个按钮，我都会收到这样的错误：

运行时错误 2683 - 此控件中没有对象

这个 Access 应用程序是在 2003 年编写的，并显示了一些日历。现在它只显示一个空白的白色字段。
当我单击Debug错误窗口时，它会显示代码。

Form_Abrechnungen.Tage.Value = Form_Abrechnungen.ActiveXCtl22.Value - Form_Abrechnungen.ActiveXCtl28.Value

在此访问应用程序可以运行之前，我必须将此 mscal.ocx 文件复制到我的C:\Windows\System32.
我读过新版本的 Office 不再支持这个，我应该使用本机日期选择器。
但我真的不知道该怎么做，因为这是我第一次编程访问。

这是我单击调试时显示的代码：

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

标签： vbams-access

解决方案

我读过新版本的 Office 不再支持这个，我应该使用本机日期选择器。

那是对的。

但我真的不知道该怎么做，因为这是我第一次编程访问。

有替代方法可以查找，如果原生日期选择器不符合目的，但没有一些 VBA 经验，实现起来并不容易。您应该与了解 VBA 和 Access 的人合作。

推荐阅读