Aficher image par clix ListBox
b
Bonjour,
J'ai essaye depuis quelques jours de faire apparaitre mes images par le clic d'une ligne de la ListBox, je n'y arrive toujours pas, je ne trouve pas le bon code.
Pouvez-vous m'aider ?
Merci
@+
Dim f, NbCol, NomTableau, TblBD(), ColVisu(), dchoisis1, dchoisis2, dchoisis3, dchoisis4, dchoisis5, dchoisis6, dchoisis7, dchoisis8, dchoisis9, dchoisis10, dchoisis11, dchoisis12, dchoisis13, dchoisis14, dchoisis15, dchoisis16, dchoisis17
Sub AdapterTailleFormAEcran()
Application.WindowState = xlMaximized
If ActiveWindow.Width > Me.Width And ActiveWindow.Height > Me.Height Then Exit Sub
If (Round((ActiveWindow.Width * 0.95) / Me.Width, 2) * 100) - 1 < (Round((ActiveWindow.Height * 0.95) / Me.Height, 2) * 100) - 1 Then
Me.Zoom = (Round((ActiveWindow.Width * 0.95) / Me.Width, 2) * 100) - 1
Me.Width = Me.Width * Me.Zoom / 100
Me.Height = Me.Height * Me.Zoom / 100
Else
Me.Zoom = (Round((ActiveWindow.Height * 0.95) / Me.Height, 2) * 100) - 1
Me.Width = Me.Width * Me.Zoom / 100
Me.Height = Me.Height * Me.Zoom / 100
End If
End Sub
Private Sub UserForm_Initialize()
Dim j As Byte
Dim d
Dim i As Long
NomTableau = "Tableau1"
NbCol = Range(NomTableau).ListObject.ListColumns.Count
TblBD = Range(NomTableau).Resize(, NbCol + 1).Value
For j = 1 To 2
Set d = CreateObject("scripting.dictionary")
d.CompareMode = vbTextCompare
For i = LBound(TblBD) To UBound(TblBD)
d(TblBD(i, j + 4)) = vbNullString
Next i
Me.Controls("ChoixListBox" & j).List = liste_triée_sans_doublons(d.keys)
Next j
For j = 3 To 16
Set d = CreateObject("scripting.dictionary")
d.CompareMode = vbTextCompare
For i = LBound(TblBD) To UBound(TblBD)
d(TblBD(i, j + 7)) = vbNullString
Next i
Me.Controls("ChoixListBox" & j).List = liste_triée_sans_doublons(d.keys)
Next j
For j = 1 To 30
Set d = CreateObject("scripting.dictionary")
d.CompareMode = vbTextCompare
For i = LBound(TblBD) To UBound(TblBD)
Select Case j
Case 29, 30: d(TblBD(i, j - 26)) = vbNullString
Case Else: d(TblBD(i, j)) = vbNullString
End Select
Next i
Me.Controls("ComboBox" & j).List = liste_triée_sans_doublons(d.keys)
Next j
With Me.ListBox20
.ColumnCount = 31 'à par nbcol sir c'est tout le tableau qui est à prendre dans la listbox
.List = TblBD
.ColumnWidths = "75;200;75;75;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0"
End With
End Sub
Sub Affiche()
Set dchoisis1 = CreateObject("Scripting.Dictionary")
For i = 0 To Me.ChoixListBox1.ListCount - 1
If Me.ChoixListBox1.Selected(i) Then dchoisis1(Me.ChoixListBox1.List(i, 0)) = ""
Next i
Set dchoisis2 = CreateObject("Scripting.Dictionary")
For i = 0 To Me.ChoixListBox2.ListCount - 1
If Me.ChoixListBox2.Selected(i) Then dchoisis2(Me.ChoixListBox2.List(i, 0)) = ""
Next i
Set dchoisis3 = CreateObject("Scripting.Dictionary")
For i = 0 To Me.ChoixListBox3.ListCount - 1
If Me.ChoixListBox3.Selected(i) Then dchoisis3(Me.ChoixListBox3.List(i, 0)) = ""
Next i
Set dchoisis4 = CreateObject("Scripting.Dictionary")
For i = 0 To Me.ChoixListBox4.ListCount - 1
If Me.ChoixListBox4.Selected(i) Then dchoisis4(Me.ChoixListBox4.List(i, 0)) = ""
Next i
Set dchoisis5 = CreateObject("Scripting.Dictionary")
For i = 0 To Me.ChoixListBox5.ListCount - 1
If Me.ChoixListBox5.Selected(i) Then dchoisis5(Me.ChoixListBox5.List(i, 0)) = ""
Next i
Set dchoisis6 = CreateObject("Scripting.Dictionary")
For i = 0 To Me.ChoixListBox6.ListCount - 1
If Me.ChoixListBox6.Selected(i) Then dchoisis6(Me.ChoixListBox6.List(i, 0)) = ""
Next i
Set dchoisis7 = CreateObject("Scripting.Dictionary")
For i = 0 To Me.ChoixListBox7.ListCount - 1
If Me.ChoixListBox7.Selected(i) Then dchoisis7(Me.ChoixListBox7.List(i, 0)) = ""
Next i
Set dchoisis8 = CreateObject("Scripting.Dictionary")
For i = 0 To Me.ChoixListBox8.ListCount - 1
If Me.ChoixListBox8.Selected(i) Then dchoisis8(Me.ChoixListBox8.List(i, 0)) = ""
Next i
Set dchoisis9 = CreateObject("Scripting.Dictionary")
For i = 0 To Me.ChoixListBox9.ListCount - 1
If Me.ChoixListBox9.Selected(i) Then dchoisis9(Me.ChoixListBox9.List(i, 0)) = ""
Next i
Set dchoisis10 = CreateObject("Scripting.Dictionary")
For i = 0 To Me.ChoixListBox10.ListCount - 1
If Me.ChoixListBox10.Selected(i) Then dchoisis10(Me.ChoixListBox10.List(i, 0)) = ""
Next i
Set dchoisis11 = CreateObject("Scripting.Dictionary")
For i = 0 To Me.ChoixListBox11.ListCount - 1
If Me.ChoixListBox11.Selected(i) Then dchoisis11(Me.ChoixListBox11.List(i, 0)) = ""
Next i
Set dchoisis12 = CreateObject("Scripting.Dictionary")
For i = 0 To Me.ChoixListBox12.ListCount - 1
If Me.ChoixListBox12.Selected(i) Then dchoisis12(Me.ChoixListBox12.List(i, 0)) = ""
Next i
Set dchoisis13 = CreateObject("Scripting.Dictionary")
For i = 0 To Me.ChoixListBox13.ListCount - 1
If Me.ChoixListBox13.Selected(i) Then dchoisis13(Me.ChoixListBox13.List(i, 0)) = ""
Next i
Set dchoisis14 = CreateObject("Scripting.Dictionary")
For i = 0 To Me.ChoixListBox14.ListCount - 1
If Me.ChoixListBox14.Selected(i) Then dchoisis14(Me.ChoixListBox14.List(i, 0)) = ""
Next i
Set dchoisis15 = CreateObject("Scripting.Dictionary")
For i = 0 To Me.ChoixListBox15.ListCount - 1
If Me.ChoixListBox15.Selected(i) Then dchoisis15(Me.ChoixListBox15.List(i, 0)) = ""
Next i
Set dchoisis16 = CreateObject("Scripting.Dictionary")
For i = 0 To Me.ChoixListBox16.ListCount - 1
If Me.ChoixListBox16.Selected(i) Then dchoisis16(Me.ChoixListBox16.List(i, 0)) = ""
Next i
n = 0: Dim liste()
For i = LBound(TblBD) To UBound(TblBD)
tmp = TblBD(i, 5)
tmp2 = TblBD(i, 6)
tmp3 = TblBD(i, 10)
tmp4 = TblBD(i, 11)
tmp5 = TblBD(i, 12)
tmp6 = TblBD(i, 13)
tmp7 = TblBD(i, 14)
tmp8 = TblBD(i, 15)
tmp9 = TblBD(i, 16)
tmp10 = TblBD(i, 17)
tmp11 = TblBD(i, 18)
tmp12 = TblBD(i, 19)
tmp13 = TblBD(i, 20)
tmp14 = TblBD(i, 21)
tmp15 = TblBD(i, 22)
tmp16 = TblBD(i, 23)
If (dchoisis1.Exists(tmp) Or dchoisis1.Count = 0) _
And (dchoisis2.Exists(tmp2) Or dchoisis2.Count = 0) _
And (dchoisis3.Exists(tmp3) Or dchoisis3.Count = 0) _
And (dchoisis4.Exists(tmp4) Or dchoisis4.Count = 0) _
And (dchoisis5.Exists(tmp5) Or dchoisis5.Count = 0) _
And (dchoisis6.Exists(tmp6) Or dchoisis6.Count = 0) _
And (dchoisis7.Exists(tmp7) Or dchoisis7.Count = 0) _
And (dchoisis8.Exists(tmp8) Or dchoisis8.Count = 0) _
And (dchoisis9.Exists(tmp9) Or dchoisis9.Count = 0) _
And (dchoisis10.Exists(tmp10) Or dchoisis10.Count = 0) _
And (dchoisis11.Exists(tmp11) Or dchoisis11.Count = 0) _
And (dchoisis12.Exists(tmp12) Or dchoisis12.Count = 0) _
And (dchoisis13.Exists(tmp13) Or dchoisis13.Count = 0) _
And (dchoisis14.Exists(tmp14) Or dchoisis14.Count = 0) _
And (dchoisis15.Exists(tmp15) Or dchoisis15.Count = 0) _
And (dchoisis16.Exists(tmp16) Or dchoisis16.Count = 0) Then
n = n + 1
ReDim Preserve liste(1 To NbCol + 1, 1 To n)
For k = 1 To NbCol + 1
liste(k, n) = TblBD(i, k)
Next k
End If
Next i
If n > 0 Then Me.ListBox20.Column = liste Else Me.ListBox20.Clear
End Sub
Private Sub ChoixListBox1_change()
Affiche
End Sub
Private Sub ChoixListBox2_change()
Affiche
End Sub
Private Sub ChoixListBox3_change()
Affiche
End Sub
Private Sub ChoixListBox4_change()
Affiche
End Sub
Private Sub ChoixListBox5_change()
Affiche
End Sub
Private Sub ChoixListBox6_change()
Affiche
End Sub
Private Sub ChoixListBox7_change()
Affiche
End Sub
Private Sub ChoixListBox8_change()
Affiche
End Sub
Private Sub ChoixListBox9_change()
Affiche
End Sub
Private Sub ChoixListBox10_change()
Affiche
End Sub
Private Sub ChoixListBox11_change()
Affiche
End Sub
Private Sub ChoixListBox12_change()
Affiche
End Sub
Private Sub ChoixListBox13_change()
Affiche
End Sub
Private Sub ChoixListBox14_change()
Affiche
End Sub
Private Sub ChoixListBox15_change()
Affiche
End Sub
Private Sub ChoixListBox16_change()
Affiche
End Sub
Function delete_from_form_with_confirmation()
Dim answer As Integer
answer = MsgBox("Delete This Row of Data", vbQuestion + vbYesNo + vbDefaultButton2, "Confirmation")
If answer = vbYes Then
Dim rng1 As Range
Dim str_search As String
str_search = ComboBox1.Value
ActiveWorkbook.Sheets("DATABASE").Activate
Set rng1 = Sheets("DATABASE").Range("A:A").Find(str_search, , xlValues, xlWhole)
If Not rng1 Is Nothing Then
rng1.Select
Dim row_number As Long
row_number = ActiveCell.Row
ActiveWorkbook.Sheets("DATABASE").Rows(row_number).EntireRow.Delete
Else
End If
End If
End Function
Private Sub ComboBox2_Change()
If Not IsError(Application.Match(ComboBox2, Sheets("DATABASE").Range("B:B"), 0)) Then
Lign = Application.Match(ComboBox2, Sheets("DATABASE").Range("B:B"), 0)
TextBox27.Value = Sheets("DATABASE").Range("AB" & Lign).Value
TextBox28.Value = Sheets("DATABASE").Range("AC" & Lign).Value
TextBox29.Value = Sheets("DATABASE").Range("AD" & Lign).Value
TextBox30.Value = Sheets("DATABASE").Range("AE" & Lign).Value
Image1.Picture = LoadPicture(nf)
Image2.Picture = LoadPicture(nf)
Image3.Picture = LoadPicture(nf)
Image5.Picture = LoadPicture(nf)
End If
End Sub
Function copy_from_form()
Dim LastRow As Long
LastRow = ActiveWorkbook.Sheets("DATABASE").Range("A1000000").End(xlUp).Row
LastRow = LastRow + 1
With ActiveWorkbook.Sheets("DATABASE")
.Range("A" & LastRow).Value = ComboBox1.Value
.Range("B" & LastRow).Value = ComboBox2.Value
.Range("C" & LastRow).Value = ComboBox3.Value
.Range("D" & LastRow).Value = ComboBox4.Value
.Range("E" & LastRow).Value = ComboBox5.Value
.Range("F" & LastRow).Value = ComboBox6.Value
.Range("G" & LastRow).Value = ComboBox7.Value
.Range("H" & LastRow).Value = ComboBox8.Value
.Range("I" & LastRow).Value = ComboBox9.Value
.Range("J" & LastRow).Value = ComboBox10.Value
.Range("K" & LastRow).Value = ComboBox11.Value
.Range("L" & LastRow).Value = ComboBox12.Value
.Range("M" & LastRow).Value = ComboBox13.Value
.Range("N" & LastRow).Value = ComboBox14.Value
.Range("O" & LastRow).Value = ComboBox15.Value
.Range("P" & LastRow).Value = ComboBox16.Value
.Range("Q" & LastRow).Value = ComboBox17.Value
.Range("R" & LastRow).Value = ComboBox18.Value
.Range("S" & LastRow).Value = ComboBox19.Value
.Range("T" & LastRow).Value = ComboBox20.Value
.Range("U" & LastRow).Value = ComboBox21.Value
.Range("V" & LastRow).Value = ComboBox22.Value
.Range("W" & LastRow).Value = ComboBox23.Value
.Range("X" & LastRow).Value = ComboBox24.Value
.Range("Y" & LastRow).Value = ComboBox25.Value
.Range("Z" & LastRow).Value = ComboBox26.Value
.Range("AA" & LastRow).Value = TextBox26.Value
.Range("AB" & LastRow).Value = TextBox27.Value
.Range("AC" & LastRow).Value = TextBox28.Value
.Range("AD" & LastRow).Value = TextBox29.Value
.Range("AE" & LastRow).Value = TextBox30.Value
End With
End Function
Function reset_picture()
Image1.Picture = Nothing
End Function
Function reset_picture_1()
Image2.Picture = Nothing
End Function
Function reset_picture_2()
Image3.Picture = Nothing
End Function
Function reset_picture_3()
Image5.Picture = Nothing
End Function
Private Sub ListBox20_Click()
Dim i As Byte
With Me
For i = 1 To 26
.Controls("ComboBox" & i).Text = .ListBox20.List(.ListBox20.ListIndex, i - 1)
Next i
For i = 26 To 30
.Controls("TextBox" & i) = .ListBox20.List(.ListBox20.ListIndex, i)
Next i
.ComboBox1.SetFocus
End With
Call reset_picture
Call reset_picture_1
Call reset_picture_2
Call reset_picture_3
End Sub
Function reset_all_controls()
Dim ctl As MSForms.Control
For Each ctl In Me.Controls
Select Case TypeName(ctl)
Case "TextBox"
ctl.Text = ""
Case "CheckBox", "OptionButton", "ToggleButton"
ctl.Value = False
Case "ComboBox", "ListBox"
ctl.ListIndex = -1
End Select
Next ctl
End Function
Sub Tri(a, gauc, droi) ' Quick sort
ref = CStr(a((gauc + droi) \ 2))
g = gauc: d = droi
Do
Do While CStr(a(g)) < ref: g = g + 1: Loop
Do While ref < CStr(a(d)): d = d - 1: Loop
If g <= d Then
temp = a(g): a(g) = a(d): a(d) = temp
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then Call Tri(a, g, droi)
If gauc < d Then Call Tri(a, gauc, d)
End Sub
Sub TriMultiCol(a, gauc, droi, colTri) ' Quick sort'
Dim colD, colF, ref, g, d, c, temp
colD = LBound(a, 2): colF = UBound(a, 2)
ref = a((gauc + droi) \ 2, colTri)
g = gauc: d = droi
Do
Do While a(g, colTri) < ref: g = g + 1: Loop
Do While ref < a(d, colTri): d = d - 1: Loop
If g <= d Then
For c = colD To colF
temp = a(g, c): a(g, c) = a(d, c): a(d, c) = temp
Next
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then TriMultiCol a, g, droi, colTri
If gauc < d Then TriMultiCol a, gauc, d, colTri
End Sub
Private Sub CommandButton1_Click()
Dim nf As Variant
nf = Application.GetOpenFilename("Fichiers jpg,*.jpg")
If Not nf = False Then
Me.TextBox27 = nf
Me.Image1.Picture = LoadPicture(nf)
End If
End Sub
Private Sub CommandButton2_Click()
nf = Application.GetOpenFilename("Fichiers jpg,*.jpg")
If Not nf = False Then
Me.TextBox28 = nf
Me.Image2.Picture = LoadPicture(nf)
End If
End Sub
Private Sub CommandButton3_Click()
nf = Application.GetOpenFilename("Fichiers jpg,*.jpg")
If Not nf = False Then
Me.TextBox29 = nf
Me.Image3.Picture = LoadPicture(nf)
End If
End Sub
Private Sub CommandButton4_Click()
nf = Application.GetOpenFilename("Fichiers doc,*.doc")
If Not nf = False Then
Me.TextBox30 = nf
Me.Image5.Picture = LoadPicture(nf)
End If
End Sub
Private Sub CommandButton5_Click()
If ComboBox2.Value = "" Then
MsgBox "You must put a reference !"
Exit Sub
End If
Dim LastRow As Long
LastRow = ActiveWorkbook.Sheets("DATABASE").Range("A1000000").End(xlUp).Row
LastRow = LastRow + 1
With ActiveWorkbook.Sheets("DATABASE")
.Range("A" & LastRow).Value = ComboBox1.Value
.Range("B" & LastRow).Value = ComboBox2.Value
.Range("C" & LastRow).Value = ComboBox3.Value
.Range("D" & LastRow).Value = ComboBox4.Value
.Range("E" & LastRow).Value = ComboBox5.Value
.Range("F" & LastRow).Value = ComboBox6.Value
.Range("G" & LastRow).Value = ComboBox7.Value
.Range("H" & LastRow).Value = ComboBox8.Value
.Range("I" & LastRow).Value = ComboBox9.Value
.Range("J" & LastRow).Value = ComboBox10.Value
.Range("K" & LastRow).Value = ComboBox11.Value
.Range("L" & LastRow).Value = ComboBox12.Value
.Range("M" & LastRow).Value = ComboBox13.Value
.Range("N" & LastRow).Value = ComboBox14.Value
.Range("O" & LastRow).Value = ComboBox15.Value
.Range("P" & LastRow).Value = ComboBox16.Value
.Range("Q" & LastRow).Value = ComboBox17.Value
.Range("R" & LastRow).Value = ComboBox18.Value
.Range("S" & LastRow).Value = ComboBox19.Value
.Range("T" & LastRow).Value = ComboBox20.Value
.Range("U" & LastRow).Value = ComboBox21.Value
.Range("V" & LastRow).Value = ComboBox22.Value
.Range("W" & LastRow).Value = ComboBox23.Value
.Range("X" & LastRow).Value = ComboBox24.Value
.Range("Y" & LastRow).Value = ComboBox25.Value
.Range("Z" & LastRow).Value = ComboBox26.Value
.Range("AA" & LastRow).Value = TextBox26.Value
.Range("AB" & LastRow).Value = TextBox27.Value
.Range("AC" & LastRow).Value = TextBox28.Value
.Range("AD" & LastRow).Value = TextBox29.Value
.Range("AE" & LastRow).Value = TextBox30.Value
MsgBox "Your reference has been added!"
End With
Unload Me
MODEMIDENTIFICATION.show
UserForm_Initialize
End Sub
Private Sub CommandButton6_Click()
reset_all_controls
UserForm_Initialize
End Sub
Private Sub CommandButton7_Click()
Unload MODEMIDENTIFICATION
End Sub
Private Sub CommandButton8_Click()
If Not IsError(Application.Match(ComboBox2, Sheets("DATABASE").Range("B:B"), 0)) Then
Lign = Application.Match(ComboBox2, Sheets("DATABASE").Range("B:B"), 0)
End If
Dim LastRow As Long
LastRow = ActiveWorkbook.Sheets("DATABASE").Range("A1000000").End(xlUp).Row
LastRow = LastRow + 1
With ActiveWorkbook.Sheets("DATABASE")
.Range("A" & LastRow).Value = ComboBox1.Value
.Range("B" & LastRow).Value = ComboBox2.Value
.Range("C" & LastRow).Value = ComboBox3.Value
.Range("D" & LastRow).Value = ComboBox4.Value
.Range("E" & LastRow).Value = ComboBox5.Value
.Range("F" & LastRow).Value = ComboBox6.Value
.Range("G" & LastRow).Value = ComboBox7.Value
.Range("H" & LastRow).Value = ComboBox8.Value
.Range("I" & LastRow).Value = ComboBox9.Value
.Range("J" & LastRow).Value = ComboBox10.Value
.Range("K" & LastRow).Value = ComboBox11.Value
.Range("L" & LastRow).Value = ComboBox12.Value
.Range("M" & LastRow).Value = ComboBox13.Value
.Range("N" & LastRow).Value = ComboBox14.Value
.Range("O" & LastRow).Value = ComboBox15.Value
.Range("P" & LastRow).Value = ComboBox16.Value
.Range("Q" & LastRow).Value = ComboBox17.Value
.Range("R" & LastRow).Value = ComboBox18.Value
.Range("S" & LastRow).Value = ComboBox19.Value
.Range("T" & LastRow).Value = ComboBox20.Value
.Range("U" & LastRow).Value = ComboBox21.Value
.Range("V" & LastRow).Value = ComboBox22.Value
.Range("W" & LastRow).Value = ComboBox23.Value
.Range("X" & LastRow).Value = ComboBox24.Value
.Range("Y" & LastRow).Value = ComboBox25.Value
.Range("Z" & LastRow).Value = ComboBox26.Value
.Range("AA" & LastRow).Value = TextBox26.Value
.Range("AB" & LastRow).Value = TextBox27.Value
.Range("AC" & LastRow).Value = TextBox28.Value
.Range("AD" & LastRow).Value = TextBox29.Value
.Range("AE" & LastRow).Value = TextBox30.Value
End With
Unload Me
MsgBox "modification made!"
MODEMIDENTIFICATION.show
UserForm_Initialize
End Sub
Private Sub CommandButton9_Click()
Call delete_from_form_with_confirmation
UserForm_Initialize
End Subb
Re,
C'est bon j'ai trouve le bon code !
Private Sub ListBox20_Click()
Dim i As Byte
With Me
For i = 1 To 26
.Controls("ComboBox" & i).Text = .ListBox20.List(.ListBox20.ListIndex, i - 1)
Next i
For i = 26 To 30
.Controls("TextBox" & i) = .ListBox20.List(.ListBox20.ListIndex, i)
Next i
.ComboBox1.SetFocus
On Error Resume Next
Dim MyUrl As String
Dim filepath As String
filepath = activeWorbook.Path
MyUrl = filepath & TextBox27.Value
Me.Image1.Picture = LoadPicture(MyUrl)
MyUrl = filepath & TextBox28.Value
Me.Image2.Picture = LoadPicture(MyUrl)
MyUrl = filepath & TextBox29.Value
Me.Image3.Picture = LoadPicture(MyUrl)
MyUrl = filepath & TextBox30.Value
Me.Image5.Picture = LoadPicture(MyUrl)
End With
End SubMerci !
@+