Thema: Probleme mit tbl.Listrows.add

Hallo zusammen,

ich hab ein kleines Problem und weis absolut nicht mehr weiter.
Wir haben für unsere Abteilung eine Liste zum erfassen von Paletten die aus dem Altbestand sind, die alte Liste war zu unübersichtlich sodass ich eine neue
erstellt habe mit diversen Elementen die via VBA funktionieren.
Als ich diese jedoch auf unseren Sharepoint hochgeladen hab, hat sie abrupt nicht mehr funktioniert. Ebenso taucht der Fehler jetzt in der Tabelle auf meinem Pc auf, was er vorher nicht getan hat.

Problem ist die "Zeile einfügen" Funktion, mit wird ein Anwendungs- oder objektdefinierter Fehler angezeigt bei tbl.Listrows.add

Finde dazu bei Google keine Lösung. Kann mir da jemand weiterhelfen?

Hallo,
ohne Deinen kompletten Code zu sehen ist es nahezu nicht möglich Dir
eine für Dich funktionierende Lösung anzubieten.
Vielleicht hilft Dir dieser "generalisierte" Code-Schnipsel:

    Dim tbl As ListObject

    Set tbl = Sheets(1).ListObjects(1)

    Dim tblRow As Range

    Set tblRow = tbl.ListRows.Add.Range

Gruß
Jochen

P.S.
nicht für ungut,
aber gern gesehen im Forum ist der abschließende Gruß

Danke erstmal für die schnelle Antwort und Entschuldigung meinerseits für das vergessen des abschließenden Grußes.
Der Beitrag entstand etwas in Eile, aber hier jetzt nochmal ganz in Ruhe und mit Code.
Wie gesagt, es funktioniert alles bis auf die Zeile mit dem .Add

Kann auch gerne die ganze Datei hochladen wenn das einfacher wäre eine Lösung zu finden.

Gruß
Christian

Option Explicit



Sub EintragLoeschen()



'Abfrage, ob der Eintrag wirklich gelöscht werden soll

Dim Antwort



Antwort = MsgBox("Soll der Eintrag wirklich gelöscht werden?", vbYesNo + vbQuestion, "Eintrag löschen?")



If Antwort = vbYes Then ActiveCell.EntireRow.Delete





End Sub



Sub Change_EingabeDB()



'Tabelle einlesen

Dim tbl As ListObject

Set tbl = tb_Datenbank.ListObjects(1)



Dim Zeile As Long



'Anlegen oder Bearbeiten?

If tb_Bearbeitung.Shapes.Range(Array("txt_Anlegen", "img_Anlegen")).Visible = True Then



'Anlegen



    'Zeile hinzufügen

    tbl.ListRows.Add

    

    'Zeile in Variable speichern

    Zeile = tbl.DataBodyRange.Rows.Count

    

Else



'Bearbeiten



    Zeile = Range("tblAltbestand[ID-Nr.]").Find(What:=tb_Bearbeitung.Range("H14").Value _

    , LookIn:=xlValues, LookAt:=xlWhole).Row - tbl.HeaderRowRange.Row





End If



'Datenbank befüllen

With tb_Bearbeitung

    tbl.DataBodyRange(Zeile, 1).Value = .Range("H14").Value

    tbl.DataBodyRange(Zeile, 4).Value = .Range("H20").Value

    tbl.DataBodyRange(Zeile, 6).Value = .Range("H22").Value

    tbl.DataBodyRange(Zeile, 5).Value = .Range("H24").Value

    tbl.DataBodyRange(Zeile, 8).Value = .Range("H26").Value

    tbl.DataBodyRange(Zeile, 2).Value = .Range("L20").Value

    tbl.DataBodyRange(Zeile, 3).Value = .Range("L22").Value

    tbl.DataBodyRange(Zeile, 7).Value = .Range("L24").Value

    tbl.DataBodyRange(Zeile, 9).Value = Date



End With



'Navigieren zu Tabellenblatt Altbestand

tb_Datenbank.Select

ActiveWindow.ScrollRow = tbl.DataBodyRange(Zeile, 1).Row

tbl.DataBodyRange(Zeile, 1).Select



End Sub



Sub Anlegen_DBEingabe()



'Tabelle einlesen

Dim tbl As ListObject

Set tbl = tb_Datenbank.ListObjects(1)



With tb_Bearbeitung



    'Spalten leeren

    .Columns("H").ClearContents

    .Columns("L").ClearContents

    

    'ID-Nr. einfügen

    .Range("H14").Value = tbl.DataBodyRange(tbl.DataBodyRange.Rows.Count, 1).Value + 1

    

    'Navigieren auf das Eingabeformular

    .Shapes.Range(Array("txt_Anlegen", "img_Anlegen")).Visible = True

    .Shapes.Range(Array("txt_Bearbeiten", "img_Bearbeiten")).Visible = False

    .Select

    

    'Zelle auswählen

    .Range("H20").Select

        

End With



End Sub



Sub Bearbeiten_DBEingabe()



'Tabelle einlesen

Dim tbl As ListObject

Set tbl = tb_Datenbank.ListObjects(1)



Dim Zeile As Long

Zeile = ActiveCell.Row - tbl.HeaderRowRange.Row





With tb_Bearbeitung



    'Spalten leeren

    .Columns("H").ClearContents

    .Columns("L").ClearContents

    

    'Eingabeformular befüllen

    .Range("H14").Value = tbl.DataBodyRange(Zeile, 1).Value

    .Range("H20").Value = tbl.DataBodyRange(Zeile, 4).Value

    .Range("H22").Value = tbl.DataBodyRange(Zeile, 6).Value

    .Range("H24").Value = tbl.DataBodyRange(Zeile, 5).Value

    .Range("L20").Value = tbl.DataBodyRange(Zeile, 2).Value

    .Range("L22").Value = tbl.DataBodyRange(Zeile, 3).Value

    .Range("L24").Value = tbl.DataBodyRange(Zeile, 7).Value

    

    'Navigieren auf das Eingabeformular

    .Shapes.Range(Array("txt_Anlegen", "img_Anlegen")).Visible = False

    .Shapes.Range(Array("txt_Bearbeiten", "img_Bearbeiten")).Visible = True

    .Select

    

    'Zelle auswählen

    .Range("H20").Select

        

End With



End Sub

Hallo Christian,
Ziitat: "Kann auch gerne die ganze Datei hochladen wenn das einfacher wäre eine Lösung zu finden."
Ja, das wäre sicher hilfreich.
Was auffällt: Du hast nicht definiert was sich z.B. hinter tb_Bearbeitung verbirgt (das müsste doch eine Tabelle sein, oder?)
Gruß
Jochen

Ja hinter tb_Bearbeitung verbirgt sich eine Arbeitsmappe.
Ich lade mal die Excel Tabelle im gesamten hoch dann macht das ganze evtl mehr Sinn.

Link zu der Tabelle:
https://www.herber.de/bbs/user/168957.xlsm

Danke auf jeden Fall schonmal fürs drüber schauen Jochen.

Gruß
Christian

Christian,
versuchs mal so:

Sub Change_EingabeDB()

  'Tabelle einlesen

  Dim tb_Datenbank

  Dim tbl As ListObject

  Dim Zeile As Long

  Set tb_Datenbank = Sheets("Altbestand") 'wenn das so korrekt ist???

  Set tbl = tb_Datenbank.ListObjects(1)

  'Anlegen oder Bearbeiten?

  If tb_Bearbeitung.Shapes.Range(Array("txt_Anlegen", "img_Anlegen")).Visible = True Then

      'Anlegen

      'Zeile hinzufügen

      tbl.ListRows.Add 

      '...... usw

Gruß
Jochen

Hallo,
das Listobject ist inkonsistent.
Konvertiere den Bereich und setze das Listobjekt neu, dann funktioniert .add wieder normal.

Gruß Uwe

du kannst mit der .add.Range Methode gleich die erzeugte Zeile füttern.
Dazu nutzt man am besten ein kleines Array.
so:

Sub Change_EingabeDB()

    Dim arr()

'Tabelle einlesen

    Dim tbl As ListObject

    Set tbl = tb_Datenbank.ListObjects(1)

    With tb_Bearbeitung

        arr = Array(.Range("H14").Value, .Range("L20").Value, .Range("L22").Value, .Range("H20").Value, .Range("H24").Value, .Range("H22").Value, .Range("L24").Value, .Range("H26").Value, Date)

    End With

'Anlegen oder Bearbeiten?

    If tb_Bearbeitung.Shapes.Range(Array("txt_Anlegen", "img_Anlegen")).Visible = True Then



        'Zeile hinzufügen und füllen

        tbl.ListRows.Add.Range.Resize(1, UBound(arr) + 1) = arr

    Else

        'Bearbeiten

    Zeile = Range("tblAltbestand[ID-Nr.]").Find(What:=tb_Bearbeitung.Range("H14").Value _

        , LookIn:=xlValues, LookAt:=xlWhole).Row - tbl.HeaderRowRange.Row

    End If

    'Navigieren zu Tabellenblatt Altbestand

    tb_Datenbank.Select

    ActiveWindow.ScrollRow = tbl.DataBodyRange(Zeile, 1).Row

    tbl.DataBodyRange(tbl.ListRows.Count, 1).Select

End Sub

Hallo Uwe,

danke für deine Antwort.
Das werde ich gleich mal testen.

Gruß
Christian

Hallo,

die Zeile erschließt sich mir auch nicht:

If tb_Bearbeitung.Shapes.Range(Array("txt_Anlegen", "img_Anlegen")).Visible = True Then

Werden unter bestimmten Bedingungen diese beiden Shapes auf .Visible=False gesetzt?
Wenn nicht, dann kann If/Else.. Abfrage auch raus.
so:

Sub Change_EingabeDB()

    Dim arr()

    'Tabelle einlesen

    Dim tbl As ListObject

    Set tbl = tb_Datenbank.ListObjects(1)

    With tb_Bearbeitung

        arr = Array(.Range("H14").Value, .Range("L20").Value, .Range("L22").Value, .Range("H20").Value, .Range("H24").Value, .Range("H22").Value, .Range("L24").Value, .Range("H26").Value, Date)

    End With

        'Zeile hinzufügen und füllen

    tbl.ListRows.Add.Range.Resize(1, UBound(arr) + 1) = arr

    'Navigieren zu Tabellenblatt Altbestand

    tb_Datenbank.Select

    ActiveWindow.ScrollRow = tbl.DataBodyRange(tbl.ListRows.Count, 1).Row

    tbl.DataBodyRange(tbl.ListRows.Count, 1).Select

End Sub

Gruß Uwe

sorry, hatte eine Dimensionierung zu viel rausgenommen.

Sub Change_EingabeDB()

    Dim arr()

    Dim Zeile

'Tabelle einlesen

    Dim tbl As ListObject

    Set tbl = tb_Datenbank.ListObjects(1)

    With tb_Bearbeitung

        arr = Array(.Range("H14").Value, .Range("L20").Value, .Range("L22").Value, .Range("H20").Value, .Range("H24").Value, .Range("H22").Value, .Range("L24").Value, .Range("H26").Value, Date)

    End With

'Anlegen oder Bearbeiten?

    If tb_Bearbeitung.Shapes.Range(Array("txt_Anlegen", "img_Anlegen")).Visible = True Then



        'Zeile hinzufügen und füllen

        tbl.ListRows.Add.Range.Resize(1, UBound(arr) + 1) = arr

    Else

        'Bearbeiten

    Zeile = Range("tblAltbestand[ID-Nr.]").Find(What:=tb_Bearbeitung.Range("H14").Value _

        , LookIn:=xlValues, LookAt:=xlWhole).Row - tbl.HeaderRowRange.Row

    End If

    'Navigieren zu Tabellenblatt Altbestand

    tb_Datenbank.Select

    ActiveWindow.ScrollRow = tbl.DataBodyRange(Zeile, 1).Row

    tbl.DataBodyRange(tbl.ListRows.Count, 1).Select

End Sub

Gruß Uwe

Der Fehler kommt dennoch in der Add Zeile.

tbl.ListRows.Add.Range.Resize(1, UBound(arr) + 1) = arr

Das macht doch irgendwie alles gar keinen Sinn.
Zumal vorher die +80 Einträge ohne Fehler übernommen wurden und urplötzlich kommt dieser Fehler.

Danke dir Uwe trotzdem für die Hilfe.

Gruß
Christian

Hallo Jochen,

nein das funktioniert leider auch nicht, erst bleibt dennoch bei der Zeile tbl.Listrows.add hängen.

Gibt es den keine andere Möglichkeit eine neue Zeile zu generieren oder?

Gruß
Christian

versuchs mal mit dem Tipp von Alwin

Gruß
Jochen

Evtl kommt der Fehler weil du im Namensmanager die Tabelle zweimal verwendet hast. Auch ich mußte die intelligente Tabelle neu erstellen.

Ich war auch mal so frei und hab deine Makros etwas umgebastelt.
H14 erhält eine Dropdownliste wenn eine neue Zeile in die Datenbank geschrieben wird.
Ich habe das Listrow Objekt benutzt.
Anlegen_DBEingabe = nur Eingabeformular leermachen und in H14 wird Neu "geschrieben"
Formularfuellen(Optional id& = 0) = wird aufgerufen wenn H14 sich ändert über Worksheet_Change.

Private Sub Worksheet_Change(ByVal Target As Range)

  If Target.Address(0, 0) = "H14" Then

     Formularfuellen IIf(Target.Value = "", 0, Target.Value)

  End If

End Sub

Change_EingabeDB = setzt die Listrow auf eine neue Zeile oder auf die Bekannte.
ListeAktualisieren =setzt dropdownliste in H14

Sub Change_EingabeDB()



'Tabelle einlesen

Dim tab_1 As ListObject

Dim lstrow As ListRow

Set tab_1 = tb_Datenbank.ListObjects("tblAltbestand")



Dim Zeile



'Anlegen oder Bearbeiten?

 If tb_Bearbeitung.Range("H14").Value = "Neu" Then

    Set lstrow = tab_1.ListRows.Add

    lstrow.Range(1) = WorksheetFunction.Max(tab_1.ListColumns("ID-Nr.").DataBodyRange) + 1

    ListeAktualisieren

Else

    Zeile = Application.WorksheetFunction.Match(tb_Bearbeitung.Range("H14").Value, tab_1.ListColumns("ID-Nr.").DataBodyRange, 0)

    If IsNumeric(Zeile) Then

        Set lstrow = tab_1.ListRows(Zeile)

    Else

        Set lstrow = Nothing

    End If

End If



If Not lstrow Is Nothing Then

'Datenbank befüllen

   With tb_Bearbeitung

    Application.EnableEvents = False

    

    'lstrow.Range(1).Value = .Range("H14").Value 'wird nur bei Neu gesetzt.

    lstrow.Range(4).Value = .Range("H20").Value

    lstrow.Range(6).Value = .Range("H22").Value

    lstrow.Range(5).Value = .Range("H24").Value

    lstrow.Range(8).Value = .Range("H26").Value

    lstrow.Range(2).Value = .Range("L20").Value

    lstrow.Range(3).Value = .Range("L22").Value

    lstrow.Range(7).Value = .Range("L24").Value

    lstrow.Range(9).Value = Date

  

   

   .Range("H14,H20,H22,H24,H26,L20,L22,L24").ClearContents

   Application.EnableEvents = True

End With

End If



End Sub



Sub Anlegen_DBEingabe()



'Tabelle einlesen

Dim tbl As ListObject

Set tbl = tb_Datenbank.ListObjects(1)





With Worksheets("Eingabeformular")

   

  Application.EnableEvents = False

  .Range("H14,H20,H22,H24,H26,L20,L22,L24").ClearContents

    'ID-Nr. einfügen

   .Range("H14").Value = "Neu"  ' WorksheetFunction.Max(tbl.ListColumns("ID-Nr.").DataBodyRange) + 1



   Application.EnableEvents = True

    

End With



End Sub



Sub Formularfuellen(Optional id& = 0)



'Tabelle einlesen

Dim tbl As ListObject, lstrow As ListRow, Zeile

Set tbl = tb_Datenbank.ListObjects(1)



With Worksheets("Eingabeformular")

  

  Application.EnableEvents = False

  

  .Range("H20,H22,H24,H26,L20,L22,L24").ClearContents

  

  If id > 0 Then

  

   Zeile = Application.WorksheetFunction.Match(id, tbl.ListColumns("ID-Nr.").DataBodyRange, 0)

   If IsNumeric(Zeile) Then

   

   Set lstrow = tbl.ListRows(Zeile)

 

   'Eingabeformular befüllen

   '.Range("H14").Value = lstrow.Range(1).Value 'dropdown: einlesen unnötig

   .Range("H20").Value = lstrow.Range(4).Value

   .Range("H22").Value = lstrow.Range(6).Value

   .Range("H24").Value = lstrow.Range(5).Value

   .Range("H26").Value = lstrow.Range(8).Value

   .Range("L20").Value = lstrow.Range(2).Value

   .Range("L22").Value = lstrow.Range(3).Value

   .Range("L24").Value = lstrow.Range(7).Value

   Application.EnableEvents = True

   End If

 End If

End With



End Sub



Sub ListeAktualisieren()

'dropdown für H14

    With Selection.Validation

        .Delete

        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _

        xlBetween, Formula1:="=Altbestand!" & tb_Datenbank.ListObjects(1).ListColumns(1).DataBodyRange.Address

        .IgnoreBlank = True

        .InCellDropdown = True

        .ShowInput = True

        .ShowError = True

    End With

End Sub