Foutcode data formulier; Fout-2147220995 (800401fd)

[vanginneken]

Hallo,

Ik ben (voor het eerst) een data formulier aan het maken aan de hand van informatie op internet.
Wat ik wil bereiken dat de gegevens die worden ingevuld op het formulier d.m.v. van text en keuzevelden worden weggeschreven op tabblad gegevens.
Nu krijg ik de melding Fout - 2147220995 (800401fd) tijden uitvoering: Automatiseringsfout.
Aangezien mijn kennis niet ver genoeg reikt en ik niet weet hoe deze fout op te lossen, hierbij de vraag wie kan mij helpen hierbij?

Gr. Diaan

Onderstaand de code gekopieerd:

Private Sub cmdsluiten_Click()
    Unload Me
End Sub

Private Sub cmdtoevoegen_Click()
    Dim iRow As Long
    Dim ws As Worksheet
    Set ws = Worksheets("gegevens")

    iRow = ws.Cells(Rows.Count, 1) _
    .End(x1Up).Offset(1, 0).Row

    If Trim(Me.txtprojectnummer.Value) = "" Then
    Me.txtprojectnummer.SetFocus
    MsgBox " Graag het projectnummer invoeren "
    Exit Sub
    End If

    If Trim(Me.txtopdrachtgever.Value) = "" Then
    Me.txtopdrachtgever.SetFocus
    MsgBox " Graag de opdrachtgever invoeren "
    Exit Sub
    End If

    If Trim(Me.txtcontactpersoon.Value) = "" Then
    Me.txtcontactpersoon.SetFocus
    MsgBox " Graag naam contactpersoon invoeren "
    Exit Sub
    End If

    If Trim(Me.txtadres.Value) = "" Then
    Me.txtadres.SetFocus
    MsgBox " Graag het adres invoeren "
    Exit Sub
    End If

    If Trim(Me.txtpostcodeplaats.Value) = "" Then
    Me.txtpostcodeplaats.SetFocus
    MsgBox " Graag de postcode en plaats invoeren "
    Exit Sub
    End If

    If Trim(Me.txttelefoonnummer.Value) = "" Then
    Me.txttelefoonnummer.SetFocus
    MsgBox " Graag het telefoonnummer invoeren "
    Exit Sub
    End If

    If Trim(Me.txtfaxnummer.Value) = "" Then
    Me.txtfaxnummer.SetFocus
    MsgBox " Graag het faxnummer invoeren "
    Exit Sub
    End If

    If Trim(Me.txtemailadres.Value) = "" Then
    Me.txtemailadres.SetFocus
    MsgBox " Graag het E-mailadres invoeren "
    Exit Sub
    End If

    If Trim(Me.txtmobielcp.Value) = "" Then
    Me.txtmobielcp.SetFocus
    MsgBox " Graag het mobielnummer contactpersoon invoeren "
    Exit Sub
    End If

    If Trim(Me.txtprojectnrog.Value) = "" Then
    Me.txtprojectnrog.SetFocus
    MsgBox " Graag het projectnummer opdrachtgever invoeren "
    Exit Sub
    End If

    If Trim(Me.txtnaamlocatie.Value) = "" Then
    Me.txtnaamlocatie.SetFocus
    MsgBox " Graag de naam van de locatie invoeren "
    Exit Sub
    End If

    If Trim(Me.txtadreslocatie.Value) = "" Then
    Me.txtadreslocatie.SetFocus
    MsgBox " Graag het adres van de locatie invoeren "
    Exit Sub
    End If

    If Trim(Me.txtplaatslocatie.Value) = "" Then
    Me.txtplaatslocatie.SetFocus
    MsgBox " Graag de plaats van de locatie invoeren "
    Exit Sub
    End If

    If Trim(Me.txttellocatie.Value) = "" Then
    Me.txttellocatie.SetFocus
    MsgBox " Graag het telefoonnummer van de locatie invoeren "
    Exit Sub
    End If

    If Trim(Me.txtemailadreslocatie.Value) = "" Then
    Me.txtemailadreslocatie.SetFocus
    MsgBox " Graag het E-mailadres van de locatie invoeren "
    Exit Sub
    End If

    If Trim(Me.txtgroottebouwwerk.Value) = "" Then
    Me.txtgroottebouwwerk.SetFocus
    MsgBox " Graag de grootte van het bouwwerk/object invoeren "
    Exit Sub
    End If

    If Trim(Me.txtsoortinventarisatie1.Value) = "" Then
    Me.txtsoortinventarisatie1.SetFocus
    MsgBox " Graag de soort van de inventarisatie invoeren "
    Exit Sub
    End If

    If Trim(Me.txtsoortinventarisatie2.Value) = "" Then
    Me.txtsoortinventarisatie2.SetFocus
    MsgBox " Graag de soort van de inventarisatie invoeren "
    Exit Sub
    End If

    ws.Cells(iRow, 1).Value = Me.txtprojectnummer.Value
    ws.Cells(iRow, 2).Value = Me.txtopdrachtgever.Value
    ws.Cells(iRow, 3).Value = Me.txtcontactpersoon.Value
    ws.Cells(iRow, 4).Value = Me.txtadres.Value
    ws.Cells(iRow, 5).Value = Me.txtpostcodeplaats.Value
    ws.Cells(iRow, 6).Value = Me.txttelefoonnummer.Value
    ws.Cells(iRow, 7).Value = Me.txtfaxnummer.Value
    ws.Cells(iRow, 8).Value = Me.txtemailadres.Value
    ws.Cells(iRow, 9).Value = Me.txtmobielcp.Value
    ws.Cells(iRow, 10).Value = Me.txtprojectnrog.Value
    ws.Cells(iRow, 11).Value = Me.txtnaamlocatie.Value
    ws.Cells(iRow, 12).Value = Me.txtadreslocatie.Value
    ws.Cells(iRow, 13).Value = Me.txtplaatslocatie.Value
    ws.Cells(iRow, 14).Value = Me.txttellocatie.Value
    ws.Cells(iRow, 15).Value = Me.txtemailadreslocatie.Value
    ws.Cells(iRow, 16).Value = Me.txtgroottebouwwerk.Value
    ws.Cells(iRow, 17).Value = Me.txtsoortinventarisatie1.Value
    ws.Cells(iRow, 18).Value = Me.txtsoortinventarisatie2.Value

    Me.txtprojectnummer.Value = ""
    Me.txtopdrachtgever.Value = ""
    Me.txtcontactpersoon.Value = ""
    Me.txtadres.Value = ""
    Me.txtpostcodeplaats.Value = ""
    Me.txttelefoonnummer.Value = ""
    Me.txtfaxnummer.Value = ""
    Me.txtemailadres.Value = ""
    Me.txtmobielcp.Value = ""
    Me.txtprojectnrog.Value = ""
    Me.txtnaamlocatie.Value = ""
    Me.txtadreslocatie.Value = ""
    Me.txtplaatslocatie.Value = ""
    Me.txttellocatie.Value = ""
    Me.txtemailadreslocatie.Value = ""
    Me.txtgroottebouwwerk.Value = ""
    Me.txtsoortinventarisatie1.Value = ""
    Me.txtsoortinventarisatie2.Value = ""
    Me.txtprojectnummer.SetFocus

End Sub

 

[pixcel]

Zoek in de vba help op err.number. Dan kun je achterhalen dat het hier eigenlijk om fout 509 gaat (-2147220995 - vbobjecterror).
Zonder volledige bijlage valt er niet veel meer over te zeggen.

 

[vanginneken]

reactie

Bekijk bijlage Opname.xlsm

 

[pixcel]

Ik krijg melding dat je onveilige objecten op je formulier hebt. Dit bekijk ik niet verder.

 

[vanginneken]

Dankjewel

Hallo Frans,

Ik ga het gewoon nogmaals proberen en gooi bestand weg.
Dankjewel iig voor de geboden hulp.

Met vriendelijke groet.