Excel Filmdatenbank - Excel stürzt immer ab

[schauan]

Hallöchen,

ist Diene Textbox12 auf dem Blatt BlueRay-Liste?

[MdeJong]

Hallo schauan,

ja, genau da .

[schauan]

Hallöchen,

wenn es auch das aktive Blat ist, würde ich den Punkt einfach wegnehmen. Hast Du ja bei den anderen TextBoxen auch nicht.

[MdeJong]

Hallo schauan,

den Punkt habe ich weg genommen...der Code hält immer noch an der selben Stelle an.

Wäre die Zeile denn nun an der Richtigen Stelle?

Gruß 
MdeJong

[schauan]

Hallöchen,

was kommt denn für eine Meldung? Bei mir funktioniert das ohne Punkt ...

[MdeJong]

    Hallo Schauan,

folgendes wird angezeigt:

   

Hier mein vollständiger Code hinter der Form "BluRayListe"

Code:

Private Sub CommandButton1_Click()
Dim c As Range
Dim strSuche As String
Dim strFirst As String
Dim intAnz As Integer
ListBox2.Clear
strSuche = InputBox("Filmname eingeben", "Filmsuche")
 If strSuche <> "" Then
     With Sheets("BluRay-Liste")
         Set c = .Columns(2).Find(strSuche, LookIn:=xlValues, lookat:=xlPart)
         If Not c Is Nothing Then
           strFirst = c.Address
           Do
               ListBox2.AddItem .Cells(c.Row, 2).Value
               intAnz = ListBox2.ListCount - 1
               ListBox2.List(intAnz, 1) = c.Row
               Set c = .Columns(2).FindNext(c)
           Loop While Not c Is Nothing And c.Address <> strFirst
         Else
             MsgBox "Film nicht gefunden"
         End If
     End With
 End If
End Sub


Private Sub CommandButton2_Click()
Filme_buchen.Show
End Sub

Private Sub CommandButton3_Click()
Unload BluRayListe
End Sub
Private Sub Cover_einfuegen()
  Dim xFn As Long
  Dim strDatei As String
  Dim xText As String
  Dim strPath As String
  strPath = "D:\Filmcovers\" 'Pfad anpassen <-- auf schreibweise und Backslash achten
  ListBox3.Clear
  xFn = FreeFile
  strDatei = TextBox19.Text
  With BluRayListe
      .Image1.Picture = Nothing
      On Error Resume Next
      .Image1.Picture = LoadPicture(strPath & .TextBox19.Text & ".jpg")
      If Dir(strPath & strDatei & ".txt") <> "" Then
          Open strPath & strDatei & ".txt" For Input As xFn
          Do While Not EOF(1)
              Line Input #xFn, xText
              ListBox3.AddItem xText
          Loop
          Close xFn
      End If
      On Error GoTo 0
  End With
End Sub

Private Sub CommandButton4_Click()
With Sheets("BluRay-Liste")
    ActiveCell.Offset(0, 3).Value = CCur(TextBox12)
   .Cells(CLng(TextBox20.Value) + 1, 2).Value = TextBox19.Value
   .Cells(CLng(TextBox20.Value) + 1, 3).Value = TextBox18.Value
   .Cells(CLng(TextBox20.Value) + 1, 4).Value = TextBox16.Value
   .Cells(CLng(TextBox20.Value) + 1, 5).Value = TextBox14.Value
   .Cells(CLng(TextBox20.Value) + 1, 6).Value = TextBox17.Value
   .Cells(CLng(TextBox20.Value) + 1, 7).Value = TextBox13.Value
   .Cells(CLng(TextBox20.Value) + 1, 8).Value = TextBox15.Value
   .Cells(CLng(TextBox20.Value) + 1, 9).Value = TextBox12.Value
   .Cells(CLng(TextBox20.Value) + 1, 10).Value = TextBox10.Value
   .Cells(CLng(TextBox20.Value) + 1, 11).Value = TextBox11.Value
   .Cells(CLng(TextBox20.Value) + 1, 12).Value = TextBox23.Value
   .Cells(CLng(TextBox20.Value) + 1, 13).Value = TextBox21.Value
   End With
   MsgBox "Daten wurden erfolgreich übernommen"
End Sub

Private Sub CommandButton5_Click()
   If Trim(TextBox19.Value) <> "" Then
       frm_trailer.Show
   End If
End Sub

Private Sub ListBox2_Click()
   Dim lngZeile As Long
   lngZeile = ListBox2.List(ListBox2.ListIndex, 1)
   With Sheets("BluRay-Liste")
       ActiveCell.Offset(0, 3).Value = CCur(TextBox12)
       TextBox20.Value = .Cells(lngZeile, 1).Value
       TextBox19.Value = .Cells(lngZeile, 2).Value
       TextBox18.Value = .Cells(lngZeile, 3).Value
       TextBox16.Value = .Cells(lngZeile, 4).Text
       TextBox14.Value = .Cells(lngZeile, 5).Value
       TextBox17.Value = .Cells(lngZeile, 6).Value
       TextBox13.Value = .Cells(lngZeile, 7).Value
       TextBox15.Value = .Cells(lngZeile, 8).Value
       TextBox12.Value = .Cells(lngZeile, 9).Value
       TextBox10.Value = .Cells(lngZeile, 10).Value
       TextBox11.Value = .Cells(lngZeile, 11).Value
       TextBox21.Value = .Cells(lngZeile, 14).Value
       TextBox23.Value = .Cells(lngZeile, 12).Value
       
   End With
   Call Cover_einfuegen
End Sub


Private Sub SpinButton1_SpinDown()
 If TextBox20.Value = "" Or TextBox20.Value = 1 Then Exit Sub
 TextBox20.Value = TextBox20.Value - 1
 With Sheets("BluRay-Liste")
 ActiveCell.Offset(0, 3).Value = CCur(TextBox12)
     TextBox19.Value = .Cells(TextBox20.Value + 1, 2)
     TextBox18.Value = .Cells(TextBox20.Value + 1, 3)
     TextBox16.Value = .Cells(TextBox20.Value + 1, 4)
     TextBox15.Value = .Cells(TextBox20.Value + 1, 8)
     TextBox17.Value = .Cells(TextBox20.Value + 1, 6)
     TextBox12.Value = .Cells(TextBox20.Value + 1, 9)
     TextBox13.Value = .Cells(TextBox20.Value + 1, 7)
     TextBox14.Value = .Cells(TextBox20.Value + 1, 5)
     TextBox10.Value = .Cells(TextBox20.Value + 1, 10)
     TextBox11.Value = .Cells(TextBox20.Value + 1, 11)
     TextBox23.Value = .Cells(TextBox20.Value + 1, 12)
     TextBox21.Value = .Cells(TextBox20.Value + 1, 14)
     Call Cover_einfuegen
 End With
End Sub

Private Sub SpinButton1_SpinUp()
  Dim lngMax As Long
  lngMax = WorksheetFunction.Max(Sheets("BluRay-Liste").Columns(1))
  If TextBox20.Value = lngMax Then Exit Sub
 If IsNumeric(TextBox20.Value) Then
     TextBox20.Value = TextBox20.Value + 1
 Else
     TextBox20.Value = 1
 End If
   With Sheets("BluRay-Liste")
   ActiveCell.Offset(0, 3).Value = CCur(TextBox12)
     TextBox19.Value = .Cells(TextBox20.Value + 1, 2)
     TextBox18.Value = .Cells(TextBox20.Value + 1, 3)
     TextBox16.Value = .Cells(TextBox20.Value + 1, 4)
     TextBox15.Value = .Cells(TextBox20.Value + 1, 8)
     TextBox17.Value = .Cells(TextBox20.Value + 1, 6)
     TextBox12.Value = .Cells(TextBox20.Value + 1, 9)
     TextBox13.Value = .Cells(TextBox20.Value + 1, 7)
     TextBox14.Value = .Cells(TextBox20.Value + 1, 5)
     TextBox10.Value = .Cells(TextBox20.Value + 1, 10)
     TextBox11.Value = .Cells(TextBox20.Value + 1, 11)
     TextBox23.Value = .Cells(TextBox20.Value + 1, 12)
     TextBox21.Value = .Cells(TextBox20.Value + 1, 14)
     Call Cover_einfuegen
 End With
End Sub

Private Sub TextBox10_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  If TextBox10.Value <> "" Then
      ThisWorkbook.FollowHyperlink Address:=TextBox10.Text
  End If
End Sub

Private Sub TextBox12_Change()

End Sub

Gruß
Mdejong

[Crazy Tom]

moin

überleg doch mal was in dem Code vom Spinbutton eigentlich passieren soll
werden da TextBoxen gefüllt oder werden da Werte ins Tabellenblatt geschrieben?
du hast überall die gleiche Codezeile eingefügt die jeweils in die aktive Zelle
des Tabellenblatts etwas einfügen soll was aus deiner Textbox12 kommt
ist das der Sinn des Spinbuttons?
wo hast du denn die ActiveCell her?
in deinem von mir erstellten Code ist nirgends von einer ActiveCell die Rede
also nicht einfach blind irgendeinen Code aus dem Netz kopieren der
gar nicht zu deiner Datei und Vorhaben passt
sondern erst mal die Basics lernen

MfG Tom

[MdeJong]

Morgen Tom,

Also ich müsste mal von jemanden von jedem Code (z.B "Sinbutton") jede einzelne Zeile erklärt bekommen.
Warum wird dieser Befehl jetzt so benutzt und was der ganze Code macht?

Ich nehme mal an, das der SpinButton dafür ist mir die TextBoxen zu füllen? ...nicht um ins Blatt zu schreiben.

Also gehört die Zeile dort nicht hinein.    Die habe ich in einem Beispiel irgendwo gefunden, weiß aber nicht mehr genau welche Seite.
der Code sah ähnlich aus, da dachte ich, das es doch funktionieren muss?

Also ich denke, das ich schon beim einbuchen eines neuen Films angeben muss, das die Textbox12 in Euro gespeichert wird.
Da der jetzige Code die Textbox12 die Daten als Text ins Tabellenblatt ablegt, muss der Code zum speichern der Filme dort die Angabe irgendwie haben, das er als "Euro" den Zusatz
speichern soll....sodass der Spinbutton, der die TextBoxen dann wieder füllt, auch Euroanzeigt.

Also...der Spinbutton-Code bleibt in diesem Fall unberührt.....Richtig?

Gruß

Michael

[Crazy Tom]

moin

hier mal das Prinzip, das dann auf deine TextBox und die jeweilige Spalte anpassen
so wie die restlichen TextBoxen befüllt, bzw wie die Werte in das Tabellenblatt geschrieben werden

Code:

'Eurowert aus Tabelle in eine Textbox
TextBox1.Value = Format(Range("E1"), "0.00 €")

'Eurowert aus einer Textbox in eine Zelle der Tabelle
Range("E1").Value = CCur(TextBox1)

dazu dann noch die Spalte der Tabelle mit Währung formatieren
MfG Tom

[Steffl]

Auch Hallo,

mal davon abgesehen, dass sich ActiveCell irgendwo auf dem Tabellenblatt befinden kann und eventuell es mit aktiven Tabellenblatt auch Probleme geben könnte, solltest du hier der TextBox noch ein Value anhängen.

Code:

ActiveCell.Offset(0, 3).Value = CCur(TextBox12.Value)