Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1640to1644
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Probelme mit 2 Bild

Probelme mit 2 Bild
31.08.2018 11:31:51
marta
Hallo
Ich möchte mit der Userform ein 2 Bild mit anzeigen.
1. Bild läuft gut mit. Auch wenn, ich den Namen in der Listbox ändere, ändert sich auch das Bild. Soweit so gut.
Ich möchte ich das auch für das 2 Bild.
Was muss wir ändern?
Wenn jemand eine Idee oder Vorschläge hat?
Meine Beispieldatei: https://www.herber.de/bbs/user/123669.xlsm

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Probelme mit 2 Bild
31.08.2018 11:39:41
Nepumuk
Hallo Marta,
erweitere die ListBox auf 3 Spalten. Dann so:
Private Sub UserForm_Initialize()
    ComboBox1.RowSource = "Tabelle2!$A$1:$A$36"
    
    ComboBox3.RowSource = "Tabelle2!$E$3:$E$5"
    Dim lZeile As Long
    
    TextBox1 = ""
    TextBox2 = ""
    TextBox3 = ""
    TextBox4 = ""
    TextBox5 = ""
    TextBox6 = ""
    TextBox7 = ""
    
    ListBox1.Clear
    
    With Tabelle1
        For lZeile = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
            ListBox1.AddItem .Cells(lZeile, 1).Text
            ListBox1.List(lZeile - 2, 1) = .Cells(lZeile, 5).Text
            ListBox1.List(lZeile - 2, 2) = .Cells(lZeile, 7).Text
        Next lZeile
    End With
End Sub
'Klick auf die ListBox Ereignisroutin
Private Sub ListBox1_Click()
    Dim strFile As String
    Dim lZeile As Long
    
    With ListBox1
        If .ListIndex > -1 Then
            'Prüfen ob Bild vorhanden
            If .List(.ListIndex, 1) <> "" Then
                strFile = Dir(.List(.ListIndex, 1), vbNormal)
                If strFile <> "" Then
                    Set Image1.Picture = LoadPicture(.List(.ListIndex, 1))
                Else
                    Set Image1.Picture = Nothing
                    MsgBox "Das Bild '" & .List(.ListIndex, 1) & "' wurde nicht gefunden!", vbInformation
                End If
            Else
                Set Image1.Picture = Nothing
            End If
            If .List(.ListIndex, 2) <> "" Then
                strFile = Dir(.List(.ListIndex, 2), vbNormal)
                If strFile <> "" Then
                    Set Image1.Picture = LoadPicture(.List(.ListIndex, 2))
                Else
                    Set Image1.Picture = Nothing
                    MsgBox "Das Bild '" & .List(.ListIndex, 2) & "' wurde nicht gefunden!", vbInformation
                End If
            Else
                Set Image1.Picture = Nothing
            End If
        End If
    End With
    
    TextBox1 = ""
    TextBox2 = ""
    TextBox3 = ""
    TextBox4 = ""
    TextBox5 = ""
    TextBox6 = ""
    TextBox7 = ""
    
    If ListBox1.ListIndex >= 0 Then
        lZeile = 2
        Do While Trim(CStr(Tabelle1.Cells(lZeile, 1).Value)) <> ""
            
            If ListBox1.Text = Trim(CStr(Tabelle1.Cells(lZeile, 1).Value)) Then
                
                TextBox1 = Trim(CStr(Tabelle1.Cells(lZeile, 1).Value))
                TextBox2 = Tabelle1.Cells(lZeile, 2).Value
                TextBox3 = Tabelle1.Cells(lZeile, 3).Value
                TextBox4 = Tabelle1.Cells(lZeile, 4).Value
                TextBox5 = Tabelle1.Cells(lZeile, 5).Value
                TextBox6 = Tabelle1.Cells(lZeile, 6).Value
                TextBox7 = Tabelle1.Cells(lZeile, 7).Value
                
                Exit Do
                
            End If
            
            lZeile = lZeile + 1
            
        Loop
    End If
End Sub

Gruß
Nepumuk
Anzeige
AW: Probelme mit 2 Bild
31.08.2018 19:12:47
marta
Hallo
Habe den Code so angepasst das es passt.
Wenn, ich speichern drücke wird, auch alles in die jeweilige Spalte geschrieben so passt alles.
Aber wenn, ich jetzt in der List die Namen wechsle werden nicht gleich beide Bilder angezeigt nur eins.
Die Änderung tritt erst in kraft wenn, die userform geschlossen und wieder geöffnet wird.
Wie kann ich das ändern?
Gruß Marta
AW: Probelme mit 2 Bild
31.08.2018 20:03:20
Nepumuk
Hallo Marta,
ändere mal:
Private Sub CommandButton10_Click()
    Dim Pfad As Variant
    Pfad = Application.GetOpenFilename("Alle Grafiken (*.bmp;*.gif;*.jpg), *.bmp;*.gif;*.jpg")
    If Pfad <> False Then
        TextBox5 = Pfad
        Set Image2.Picture = LoadPicture(Filename:=Pfad)
        With ListBox1
            .List(.ListIndex, 2) = Pfad
        End With
    Else
        Set Image2.Picture = Nothing
        MsgBox "Nichts ausgewählt!"
    End If
End Sub

Gruß
Nepumuk
Anzeige
AW: Probelme mit 2 Bild
31.08.2018 21:01:24
marta
Abend
Dieser Code funktioniert zwar, aber die Bilder sind vertauscht beim anklicken der Namen in der Listbox.
Wenn die Box neu geladen wird, ist wieder alles OK.
Keine Ahnung warum?
Ich lade mal die geänderte Datei, hoch vielleicht findest du ja den Fehler!
Gruß Marta
https://www.herber.de/bbs/user/123679.xlsm
AW: Probelme mit 2 Bild
01.09.2018 10:53:59
Nepumuk
Hallo Marta,
ändere:
Private Sub CommandButton3_Click()
    
    Dim lZeile As Long
    If ListBox1.ListIndex = -1 Then Exit Sub
    If Trim(CStr(TextBox1.Text)) = "" Then
        MsgBox "Sie müssen mindestens einen Namen eingeben!", vbCritical + vbOKOnly, "FEHLER!"
        Exit Sub
    End If
    lZeile = 2
    Do While Trim(CStr(Tabelle1.Cells(lZeile, 1).Value)) <> ""
        If ListBox1.Text = Trim(CStr(Tabelle1.Cells(lZeile, 1).Value)) Then
            Tabelle1.Cells(lZeile, 1).Value = Trim(CStr(TextBox1.Text))
            Tabelle1.Cells(lZeile, 2).Value = TextBox2.Text
            Tabelle1.Cells(lZeile, 3).Value = TextBox3.Text
            Tabelle1.Cells(lZeile, 4).Value = TextBox4.Text
            Tabelle1.Cells(lZeile, 5).Value = TextBox7.Text
            Tabelle1.Cells(lZeile, 6).Value = TextBox6.Text
            Tabelle1.Cells(lZeile, 7).Value = TextBox5.Text
            If ListBox1.Text <> Trim(CStr(TextBox1.Text)) Then
                Call UserForm_Initialize
                If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
            End If
            
            Exit Do
        End If
        lZeile = lZeile + 1
    Loop
End Sub

und:
Private Sub TextBox8_Change()
    Dim lZeile As Long
    
    TextBox1 = ""
    TextBox2 = ""
    TextBox3 = ""
    TextBox4 = ""
    TextBox5 = ""
    TextBox6 = ""
    TextBox7 = ""
    
    ListBox1.Clear
    
    With Tabelle1
        For lZeile = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
            If TextBox8 = "" Or .Cells(lZeile, 1) Like TextBox8 & "*" Then
                ListBox1.AddItem .Cells(lZeile, 1).Text
                ListBox1.List(ListBox1.ListCount - 1, 1) = .Cells(lZeile, 5).Text
                ListBox1.List(ListBox1.ListCount - 1, 2) = .Cells(lZeile, 7).Text
            End If
        Next lZeile
    End With
    If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
End Sub

Gruß
Nepumuk
Anzeige
AW: Probelme mit 2 Bild
01.09.2018 11:04:50
Nepumuk
Hallo Marta,
ich hab noch einen Fehler gefunden:
Private Sub ListBox1_Click()
    Dim strFile As String
    Dim lZeile As Long
    
    With ListBox1
        If .ListIndex > -1 Then
            'Prüfen ob Bild vorhanden
            If .List(.ListIndex, 1) <> "" Then
                strFile = Dir(.List(.ListIndex, 1), vbNormal)
                If strFile <> "" Then
                    Set Image1.Picture = LoadPicture(.List(.ListIndex, 1))
                Else
                    Set Image1.Picture = Nothing
                    MsgBox "Das Bild '" & .List(.ListIndex, 1) & "' wurde nicht gefunden!", vbInformation
                End If
            Else
                Set Image1.Picture = Nothing
            End If
            If .List(.ListIndex, 2) <> "" Then
                strFile = Dir(.List(.ListIndex, 2), vbNormal)
                If strFile <> "" Then
                    Set Image2.Picture = LoadPicture(.List(.ListIndex, 2))
                Else
                    Set Image2.Picture = Nothing
                    MsgBox "Das Bild '" & .List(.ListIndex, 2) & "' wurde nicht gefunden!", vbInformation
                End If
            Else
                
                Set Image2.Picture = Nothing
            End If
        End If
    End With
    
    TextBox1 = ""
    TextBox2 = ""
    TextBox3 = ""
    TextBox4 = ""
    TextBox5 = ""
    TextBox6 = ""
    TextBox7 = ""
    
    If ListBox1.ListIndex >= 0 Then
        lZeile = 2
        Do While Trim(CStr(Tabelle1.Cells(lZeile, 1).Value)) <> ""
            
            If ListBox1.Text = Trim(CStr(Tabelle1.Cells(lZeile, 1).Value)) Then
                
                TextBox1 = Trim(CStr(Tabelle1.Cells(lZeile, 1).Value))
                TextBox2 = Tabelle1.Cells(lZeile, 2).Value
                TextBox3 = Tabelle1.Cells(lZeile, 3).Value
                TextBox4 = Tabelle1.Cells(lZeile, 4).Value
                TextBox7 = Tabelle1.Cells(lZeile, 5).Value
                TextBox6 = Tabelle1.Cells(lZeile, 6).Value
                TextBox5 = Tabelle1.Cells(lZeile, 7).Value
                
                Exit Do
                
            End If
            
            lZeile = lZeile + 1
            
        Loop
    End If
End Sub

Gruß
Nepumuk
Anzeige
AW: Probelme mit 2 Bild
01.09.2018 16:23:07
marta
Hallo
Danke für deine Hilfe es funktioniert alles so, wie soll.
Sogar die Suchfunktion geht jetzt auch richtig
Gruß Marta
AW: Probelme mit 2 Bild
01.09.2018 18:53:25
Hajo_Zi
ich konnte aus Deinem Beitrag nicht lesen was offen?

Beiträge von Werner, Luc, robert, J.O.Maximo und folgende lese ich nicht.

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige