Filmcover in Userform amzeigen?

[Crazy Tom]

Hallo

kommentier mal die beiden On Error-Anweisungen aus
wenn dann der Debugger anspringt
kontrolliere welchen Wert strPath und der Bildname hat

MfG Tom

[Crazy Tom]

Hallo

den Code musst du dann auch in den Spinbutton packen, nach dem gleichen Prinzip
welchen Titel und aus welcher Textbox kannst du selber anpassen
wichtig ist nur dass das Cover gleich benannt ist, die Endung gehört nicht zwingend dazu

MfG Tom

[MdeJong]

Hi Tom,

hab versucht den Code "SpinButton" so einzugeben:

Code:

Private Sub SpinButton1_SpinDown()
  If TextBox20.Value = 0 Then Exit Sub
  TextBox20.Value = TextBox20.Value - 1
   ListBox1.Clear
Dim c As Range
  Dim strSuche As String
  Dim strPath As String
  strPath = "D:\Filme Covers"    'Pfad anpassen
  Image1.Picture = Nothing
  strSuche = InputBox("Filmname eingeben", "Filmsuche")
  If strSuche <> "" Then
  With Sheets("BluRay-Liste")
      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)
      ListBox1.AddItem .Cells(TextBox20.Value + 1, 12)
      TextBox21.Value = .Cells(TextBox20.Value + 1, 14)
  End With
On Error Resume Next
              Image1.Picture = LoadPicture(strPath & "\" & TextBox19.Text & ".jpg")
              On Error GoTo 0
             
              'und so weiter und sofort
          Else
              MsgBox "Film nicht gefunden"
          End If
      End With
  End If
 
End Sub

Private Sub SpinButton1_SpinUp()
  If IsNumeric(TextBox20.Value) Then
      TextBox20.Value = TextBox20.Value + 1
  Else
      TextBox20.Value = 1
  End If
   ListBox1.Clear
Dim c As Range
  Dim strSuche As String
  Dim strPath As String
  strPath = "D:\Filme Covers"    'Pfad anpassen
  Image1.Picture = Nothing
  strSuche = InputBox("Filmname eingeben", "Filmsuche")
  If strSuche <> "" Then
  With Sheets("BluRay-Liste")
      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)
      ListBox1.AddItem .Cells(TextBox20.Value + 1, 12)
      TextBox21.Value = .Cells(TextBox20.Value + 1, 14)
  End With
   On Error Resume Next
              Image1.Picture = LoadPicture(strPath & "\" & TextBox19.Text & ".jpg")
              On Error GoTo 0
             
              'und so weiter und sofort
          Else
              MsgBox "Film nicht gefunden"
          End If
      End With
  End If
 
End Sub

Geht natürlich nicht.

[Crazy Tom]

Hallo


heieieiei

lass den Code für den Spinbutton wie er war

diesen Code mit ins Klassenmodul der Userform

Code:

Private Sub Cover_einfuegen()
   Dim strPath As String
   strPath = "D:\Filmcover"
   With BluRayListe
       .Image1.Picture = Nothing
       On Error Resume Next
       .Image1.Picture = LoadPicture(strPath & "\" & .TextBox19.Text & ".jpg")
       On Error GoTo 0
   End With
End Sub

und im Code für den Spinbutton vor das letzte End With diese Zeile

Code:

Call Cover_einfuegen

MfG Tom

[MdeJong]

Hi Tom,

für beide Spins?

Code:

Private Sub SpinButton1_SpinDown()
  If TextBox20.Value = 0 Then Exit Sub
  TextBox20.Value = TextBox20.Value - 1
   ListBox1.Clear
  With Sheets("BluRay-Liste")
      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)
      ListBox1.AddItem .Cells(TextBox20.Value + 1, 12)
      TextBox21.Value = .Cells(TextBox20.Value + 1, 14)
      Call Cover_einfuegen
  End With
 
End Sub

Private Sub SpinButton1_SpinUp()
  If IsNumeric(TextBox20.Value) Then
      TextBox20.Value = TextBox20.Value + 1
  Else
      TextBox20.Value = 1
  End If
   ListBox1.Clear
  With Sheets("BluRay-Liste")
      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)
      ListBox1.AddItem .Cells(TextBox20.Value + 1, 12)
      TextBox21.Value = .Cells(TextBox20.Value + 1, 14)
      Call Cover_einfuegen
  End With
 
End Sub

[Crazy Tom]

klar doch

[MdeJong]

diesen Code mit ins Klassenmodul der Userform

Sorry ....Klassenmodul???

wohin?

[Crazy Tom]

hinter die Userform

[MdeJong]

  Filme.xlsm (Größe: 54,07 KB / Downloads: 2) Hi Tom,


ich verzweifle gerade..............irgendwie hab ich mit der Mappe...Code mistgebaut???

Jetzt werden wieder keine Bilder angezeigt.
Film findet die Suche auch nur, wenn ich den kompletten Titel eingebe

Mensch....bin ich zu blöd?

Gruß 
Michael

[Crazy Tom]

Hallo

in der Sub Cover_einfuegen stimmt der Pfad nicht

MfG Tom