31.05.2014, 20:11
(Dieser Beitrag wurde zuletzt bearbeitet: 31.05.2014, 20:28 von WillWissen.)
Hallo liebe Excelgemeinde,
benötige mal wieder eure Hilfe bei einen Code:
Mit diesem Code ist es mir möglich in einer Userform durck klicken in der Listbox1 Artikelnummer auszuwählen und die entsprechenden Daten dazu in die Userform zu holen und das dazugehörige Bild wird jeweils geladen! Solange ich in Listbox zwischen den ARtikeln hin und her klicke funktioniert es einwandfrei. Wenn ich aber mal auf das Bild das geladen ist klicke und dann wieder ein anderer Artikel in der Listbox auswähle, dann werde zwar die Daten dazu geladen jedoch das Bild ändert sich dann nicht mehr! Irgendwo ist da ein Fehler im Code und ich komme nicht drau wo!?
Vielleicht hat jemand eine Idee?
Vielen Dank
LG
Alexandra
benötige mal wieder eure Hilfe bei einen Code:
Code:
Private Sub ListBox1_Click() 'Listbox Auswahl
Dim sSearch As String
Dim rngID As Range
Dim Bild As Object
Dim strFile As String
CommandButton6.Visible = True
CommandButton4.Visible = True
If ListBox1.ListCount > 1 Then
sSearch = ListBox1.List(ListBox1.ListIndex, 0) 'Der ausgewählte Listeneintrag an die Variable übergeben
Set rngID = ThisWorkbook.Sheets("Datenbank").Columns("A:A").Find(What:=sSearch, LookAt:=xlWhole, LookIn:=xlValues) 'In Spalte A nach dem Wert in der Variable suchen und festhalten
If Not rngID Is Nothing Then 'Wenn nicht nicht gefunden
strFile = ThisWorkbook.Path & "\" & "bilder datenbank" & "\" & rngID.Value & ".jpg"
If Dir(strFile) <> "" Then
On Error GoTo fehler
Set Bild = LoadPicture(ThisWorkbook.Path & "\" & "bilder datenbank" & "\" & rngID.Value & ".jpg")
Image1.Picture = Bild
Image1.Visible = True
Image1.PictureSizeMode = 3 'Bildgöße apassen
i = rngID.Row
fehler:
If Err Then MsgBox "Kein Bild oder Bild fehlerhaft! Bitte Bild des Artikels" & " " & rngID.Value & " " & "prüfen!"
On Error GoTo 0
Else
Set Bild = LoadPicture(ThisWorkbook.Path & "\" & "bilder datenbank" & "\" & "keinBild" & ".jpg")
Image1.Picture = Bild
Image1.Visible = True
Image1.PictureSizeMode = 3 'Bildgöße apassen
i = rngID.Row
End If
Else
MsgBox sSearch & " wurde nicht gefunden."
Exit Sub
End If ' Auswahl
End If
i = ListBox1.ListIndex + 2
'Beep
With ThisWorkbook.Sheets("Datenbank")
TextBox4.Text = .Cells(i, 1).Value 'A
TextBox3.Text = .Cells(i, 2).Value 'B
TextBox1.Text = .Cells(i, 3).Value 'C
TextBox2.Text = .Cells(i, 4).Value 'D
TextBox5.Text = .Cells(i, 5).Value 'E
TextBox6.Text = .Cells(i, 6).Value 'F
TextBox7.Text = .Cells(i, 7).Value 'G
TextBox8.Text = .Cells(i, 8).Value 'H
TextBox9.Text = .Cells(i, 9).Value 'I
TextBox10.Text = .Cells(i, 10).Value 'J
TextBox11.Text = .Cells(i, 11).Value 'K
TextBox12.Text = .Cells(i, 12).Value 'L
TextBox13.Text = .Cells(i, 13).Value 'M
TextBox14.Text = .Cells(i, 14).Value 'N
TextBox15.Text = .Cells(i, 15).Value 'O
TextBox16.Text = .Cells(i, 16).Value 'P
TextBox17.Text = .Cells(i, 17).Value 'Q
TextBox17.Value = Format(TextBox17.Value, "####0.00 €")
TextBox18.Text = .Cells(i, 18).Value 'R
TextBox18.Value = Format(TextBox18.Value, "####0.00 €")
TextBox19.Text = .Cells(i, 19).Value 'S
TextBox19.Value = Format(TextBox19.Value, "####0.00 €")
TextBox20.Text = .Cells(i, 20).Value 'T
TextBox20.Value = Format(TextBox20.Value, "####0.00 €")
TextBox21.Text = .Cells(i, 21).Value 'U
TextBox22.Text = .Cells(i, 22).Value 'V
TextBox23.Text = .Cells(i, 23).Value 'W
TextBox24.Text = .Cells(i, 24).Value 'X
TextBox25.Text = .Cells(i, 25).Value 'Y
TextBox26.Text = .Cells(i, 26).Value 'Z
TextBox27.Text = .Cells(i, 27).Value 'AA
TextBox28.Text = .Cells(i, 28).Value 'AB
TextBox29.Text = .Cells(i, 29).Value 'AC
TextBox30.Text = .Cells(i, 30).Value 'AD
TextBox31.Text = .Cells(i, 31).Value 'AE
TextBox32.Text = .Cells(i, 32).Value 'AF
TextBox33.Text = .Cells(i, 33).Value 'AG
TextBox34.Text = .Cells(i, 34).Value 'AH
TextBox35.Text = .Cells(i, 35).Value 'AI
TextBox36.Text = .Cells(i, 36).Value 'AJ
TextBox37.Text = .Cells(i, 37).Value 'AK
'TextBox38.Text = Cells(i, 38).Value 'AL
TextBox39.Text = .Cells(i, 39).Value 'AM
TextBox39.Value = Format(TextBox39.Value, "####0.00 €")
TextBox40.Text = .Cells(i, 40).Value 'AN
TextBox40.Value = Format(TextBox40.Value, "####0.00 €")
TextBox41.Text = .Cells(i, 41).Value 'AO
TextBox41.Value = Format(TextBox41.Value, "####0.00 €")
TextBox42.Text = .Cells(i, 42).Value 'AP
TextBox42.Value = Format(TextBox42.Value, "####0.00 €")
'TextBox43.Text = Cells(i, 43).Value 'AQ
'TextBox44.Text = Cells(i, 44).Value 'AR
'TextBox45.Text = Cells(i, 45).Value 'AS
'TextBox46.Text = Cells(i, 46).Value 'AT
Label60.Caption = .Cells(i, 47).Value
Label57.Caption = .Cells(i, 48).Value
ControlsOnlyView
'TextBox4.Enabled = False
'CommandButton6.Visible = False
'CommandButton4.Visible = False
End With
End Sub
Vielleicht hat jemand eine Idee?
Vielen Dank
LG
Alexandra