Excel Filmdatenbank - Excel stürzt immer ab

[MdeJong]

  Videothek - Kopie.xlsm (Größe: 113,32 KB / Downloads: 6) Hallo Excelfreunde,

habe mit Hilfe von euch meine Filmdatenbank zum abspeichern und anzeigen von Blu Ray Filmen fertig bekommen...dachte ich 

Nun stürzt Excel immer beim speichern des 9. Filmes ab.

Bis 8 Filme einbuchen klappt...alles wird angezeigt.
Ab dem 9. Film einbuchen...friert Excel sozusagen ein und ich kann nur noch den Taskmanager aufrufen und Excel killen.


Ich bin Ratlos?

Vielleicht ist bei euch schon einmal ein ähnliches Problem aufgetaucht?

Ich brauch Hilfe :22:

Gruß
MdeJong

[Crazy Tom]

ich denke mal es liegt daran dass beim einbuchen des Films entweder

noch kein Cover

oder

noch keine Textdatei

im Ordner vorliegen

MfG Tom

[MdeJong]

Ich weiß nicht.....ich probiere es jetzt noch einmal aus....ich habe für 3 Filme Cover und texte...also alles zusammen.
Kommen dann auf 10 Filme

[MdeJong]

Es wird wohl daran gelegen haben
Jetzt sind  3 Filme neu eingebucht, komplett mit allen Angaben...Cover in Textinhalt.
Aber ist das eine dauerhaft gute Lösung, das ich immer alles komplett eingeben muss...damit Excel nicht einfriert?


Gruß
Michael

[Crazy Tom]

Hallo Michael

hier habe ich jetzt noch eine Prüfung eingebaut ob die Textdatei existiert
schau mal wenn du diesen Code komplett ersetzt ob es dann funktioniert

Code:

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

MfG Tom

[MdeJong]

Guten Morgen Crazy Tom,

danke für deine Hilfe.
Ich habe jetzt weitere 3 Filme ohne Cover eingegeben.....bisher keine Probleme.

Mal schauen, ob die Filmdatenbank weiterhin ohne Fehler läuft? :)

Eine Frage noch:
Nach drücken auf Trailer, kommt siehe Bild die se Meldung.
   

Klick auf OK und es geht weiter.

kann man die Meldung irgendwo ausschalten?
Ich hab bisher in den Exceleinstellungen nichts gefunden.

Und wie kann man der Textbox12 in der userForm "BlueRayListe" sagt, zeige auch den Wert in Euro an und übernimm das auch in der Datentabelle.
Gruß
Michael

[Crazy Tom]

Hallo

weiß nicht ob man das Meldungsfenster unterdrücken kann

zu deiner Textbox:

gib doch mal in der Suchmaschine deines Vertrauens diese Stichworte ein

excel vba format textbox euro


MfG Tom

[WillWissen]

Hi Michael,

liegt deine Datei an einem vertrauenswürdigen Ort? Das kannst du in Optionen/Trust Center prüfen und einstellen. Möglicherweise kommt die Meldung dann nicht mehr.

[MdeJong]

Hallo, CrazyTom und Hallo WillWissen,

ok...werd ich machen.

[MdeJong]

So hab jetzt etwas gefunden, was meinem Code ähnlich sah.

habe diese Zeile gefunden zum Anzeigen Textboxinhalt in Euro:

Code:

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

Diese Zeile habe ich dann in meinem SpinButton Code an gleicher Stelle eingefügt:

Code:

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

Beim ausführen blieb er an dieser Stelle stehen.

Gefunden hab ich die Lösung unter folgenden Link: http://www.herber.de/forum/archiv/352to3...xtbox.html

beatwortet von Rainer

War wohl falsch?

Oder lag ich schon fast richtig?

Gruß

MdeJong