Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema MultiPage
BildScreenshot zu MultiPage MultiPage-Seite mit Beispielarbeitsmappe aufrufen

Laufzeitfehler 381

Betrifft: Laufzeitfehler 381 von: Dirk
Geschrieben am: 01.11.2014 12:47:54

Guten Tag ins Forum,

ich habe folgendes Problem :

Ein UF ist mit 2 Multipages bestückt. Beide enthalten jeweils eine Listbox, die beim Start des UF mit Daten befüllt werdenBeim Wechseln der Listboxen bekomme ich den Laufzeitfehler 381 angezeigt. Ich häng mal die Codes zum Befüllen der Listboxen und Einlesen in die Textboxen mit an.

Vielen Dank im Voraus

Grüße aus Hessen Dirk

Private Sub Dateneinlesen2()
Dim Pfad As String
 Pfad = ActiveWorkbook.Sheets("Verzeichnisse").Range("A1").Value
Workbooks.Open Pfad & "FzKuDaBa.xlsx"
 With Workbooks("FzKuDaBa.xlsx").Sheets("KFZ").Range("A:A")
 Dim rngCell2 As Range
 Dim strfirstaddress2 As String
 Me.MultiPage1.Pages(1).LBM1P1_0001.Clear
  Set rngCell2 = .Find(Me.MultiPage1.Pages(0).TBM1P0_0001.Value, LookIn:=xlValues, lookat:= _
xlWhole)
    If Not rngCell2 Is Nothing Then
      strfirstaddress2 = rngCell2.Address
      Do
        With Me.MultiPage1.Pages(1).LBM1P1_0001
        .ColumnCount = 10
          .AddItem
          .List(.ListCount - 1, 0) = rngCell2.Value
          .List(.ListCount - 1, 1) = rngCell2.Offset(0, 1).Value    'B amtl. Kennz.
          .List(.ListCount - 1, 2) = rngCell2.Offset(0, 2).Value    'C Hersteller
          .List(.ListCount - 1, 3) = rngCell2.Offset(0, 3).Value    'D Modell
          .List(.ListCount - 1, 4) = rngCell2.Offset(0, 4).Value    'E Ausstattung
          .List(.ListCount - 1, 5) = rngCell2.Offset(0, 5).Value    'F Fahrgest.-Nr.
          .List(.ListCount - 1, 6) = rngCell2.Offset(0, 6).Value
          .List(.ListCount - 1, 7) = rngCell2.Offset(0, 7).Value
          .List(.ListCount - 1, 8) = rngCell2.Offset(0, 8).Value
          .List(.ListCount - 1, 9) = rngCell2.Offset(0, 9).Value
          .ColumnWidths = "0cm;2,0cm;2,5cm;3,0cm;3,0cm;3,0cm;0cm;0cm;0cm;0cm"
        End With
        Set rngCell2 = .FindNext(rngCell2)
        Loop While Not rngCell2 Is Nothing And rngCell2.Address <> strfirstaddress2
      Else
       MsgBox "Kein Fahrzeug gefunden", 48
    End If
End With
Application.DisplayAlerts = False
With Workbooks("fzkudaba.xlsx")
.Save
.Close
End With
End Sub
Private Sub Dateneinlesen3()
Dim Pfad As String
 Pfad = ActiveWorkbook.Sheets("Verzeichnisse").Range("A1").Value
 Workbooks.Open Pfad & "KuDaBa.xlsx"
 With Workbooks("KuDaBa.xlsx").Sheets("ASP").Range("A:A")
 Dim rngCell As Range
 Dim strfirstaddress As String
 Me.MultiPage2.Pages(2).LBM2P2_0001.Clear
  Set rngCell = .Find(Me.MultiPage1.Pages(0).TBM1P0_0001.Value, LookIn:=xlValues, lookat:= _
xlWhole)
    If Not rngCell Is Nothing Then
      strfirstaddress = rngCell.Address
      Do
        With Me.MultiPage2.Pages(2).LBM2P2_0001
        .ColumnCount = 10
          .AddItem
          .List(.ListCount - 1, 0) = rngCell.Value
          .List(.ListCount - 1, 1) = rngCell.Offset(0, 1).Value
          .List(.ListCount - 1, 2) = rngCell.Offset(0, 2).Value
          .List(.ListCount - 1, 3) = rngCell.Offset(0, 3).Value
          .List(.ListCount - 1, 4) = rngCell.Offset(0, 4).Value
          .List(.ListCount - 1, 5) = rngCell.Offset(0, 5).Value
          .List(.ListCount - 1, 6) = rngCell.Offset(0, 6).Value
          .List(.ListCount - 1, 7) = rngCell.Offset(0, 7).Value
          .List(.ListCount - 1, 8) = rngCell.Offset(0, 8).Value
          .List(.ListCount - 1, 9) = rngCell.Offset(0, 9).Value
          .ColumnWidths = "0cm;1,2cm;1,7cm;3,0cm;3,0cm;2,4cm;0cm;0cm;0cm;0cm"
        End With
        Set rngCell = .FindNext(rngCell)
        Loop While Not rngCell Is Nothing And rngCell.Address <> strfirstaddress
      Else
       MsgBox "Kein Ansprechpartner gefunden", 48
    End If
End With
Application.DisplayAlerts = False
With Workbooks("kudaba.xlsx")
.Save
.Close
End With
End Sub
Private Sub LBM1P1_0001_Change()
    If LBM1P1_0001.Tag <> "" Then Exit Sub
    TBM1P1_0001 = LBM1P1_0001.List(LBM1P1_0001.ListIndex, 1)
    TBM1P1_0002 = LBM1P1_0001.List(LBM1P1_0001.ListIndex, 2)
    TBM1P1_0003 = LBM1P1_0001.List(LBM1P1_0001.ListIndex, 3)
    TBM1P1_0004 = LBM1P1_0001.List(LBM1P1_0001.ListIndex, 4)
    TBM1P1_0005 = LBM1P1_0001.List(LBM1P1_0001.ListIndex, 5)
    TBM1P1_0006 = LBM1P1_0001.List(LBM1P1_0001.ListIndex, 6)
    TBM1P1_0007 = LBM1P1_0001.List(LBM1P1_0001.ListIndex, 7)
    TBM1P1_0008 = LBM1P1_0001.List(LBM1P1_0001.ListIndex, 8)
    TBM1P1_0009 = LBM1P1_0001.List(LBM1P1_0001.ListIndex, 9)
End Sub
Private Sub LBM2P2_0001_Change()
    If LBM2P2_0001.Tag <> "" Then Exit Sub
    CBM2P2_0001 = LBM2P2_0001.List(LBM2P2_0001.ListIndex, 1)
    CBM2P2_0002 = LBM2P2_0001.List(LBM2P2_0001.ListIndex, 2)
    TBM2P2_0001 = LBM2P2_0001.List(LBM2P2_0001.ListIndex, 3)
    TBM2P2_0002 = LBM2P2_0001.List(LBM2P2_0001.ListIndex, 4)
    CBM2P2_0003 = LBM2P2_0001.List(LBM2P2_0001.ListIndex, 5)
    TBM2P2_0003 = LBM2P2_0001.List(LBM2P2_0001.ListIndex, 6)
    TBM2P2_0004 = LBM2P2_0001.List(LBM2P2_0001.ListIndex, 7)
    TBM2P2_0005 = LBM2P2_0001.List(LBM2P2_0001.ListIndex, 8)
    TBM2P2_0006 = LBM2P2_0001.List(LBM2P2_0001.ListIndex, 9)
End Sub

  

Betrifft: AW: Laufzeitfehler 381 von: Luschi
Geschrieben am: 02.11.2014 09:02:08

Hallo Dirk,

wenn Du eine Demodatei mit Testdaten hier bereitstellst, werde ich mich auf die Suche nach dem Fehlerteufel machen.

Gruß von Luschi
aus klein-Paris


  

Betrifft: AW: Laufzeitfehler 381 von: Dirk
Geschrieben am: 03.11.2014 14:02:51

Hallo Luschi,

vielen Dank für Deine schnelle Antwort.
Leider läßt sich die Datei wegen Ihrer
Größe von 2,1 MB nicht uploaden.
Vielleicht kannst Du mir ja mal Deine
E-Mail-Adresse zukommen lassen, dann kann
ich Dir die Dateien direkt schicken.
Meine ist dirk_graf@t-online.de.

Vielen Dank nach "Klaa Paris"

Dirk


 

Beiträge aus den Excel-Beispielen zum Thema "Laufzeitfehler 381"