inserer photos dans unserform suivant combobox

davidg

XLDnaute Nouveau
bonjour

je n arrive pas a inserer l image dans mon userform

et je ne sais comment faire

voici mon code vba


cordialement

Private Sub UserForm_Initialize()
Dim CTRL As Control
Dim cell As Range
Dim Plage As Range
Dim i As Integer
Me.Caption = X

For Each CTRL In Controls
If CTRL.Tag = "C" Then CTRL.Visible = False
Next

With SpinButton1
.Min = 1
.Max = 100
.Value = 1
End With

Set MonBook = ThisWorkbook
With MonBook
Set WS1 = .Worksheets("articles 2")
Set WS2 = .Worksheets("devis")
End With

If WS1.AutoFilterMode Then
WS1.AutoFilterMode = False
WS1.Range("B5").AutoFilter
Else
WS1.Range("B5").AutoFilter
End If

Set Plage = WS1.Range("B6:" _
& WS1.Range("B65536").End(xlUp).Address)
ReDim Tab1(0 To Plage.Count)
i = 0
For Each cell In Plage
i = i + 1

With cell
Tab1(i) = .Text
End With
Next

TriLB1
DouLB1
End Sub

Private Sub TriLB1()
Dim ValMin As Integer, ValSup As Integer
Dim i As Integer, J As Integer, ii As Integer
Dim T1 As String, T2 As String
ValMin = LBound(Tab1)
ValSup = UBound(Tab1) ' - 1
For i = ValMin To ValSup
For J = ValMin + ii To ValSup
If Tab1(i) > Tab1(J) Then
T1 = Tab1(J): T2 = Tab1(J)
Tab1(J) = Tab1(i): Tab1(J) = Tab1(i)
Tab1(i) = T1: Tab1(i) = T2
End If
Next J
ii = ii + 1
Next i
End Sub
Private Sub DouLB1()
Dim i As Integer, ii As Integer, iii As Integer
Dim Item As String
Item = ""
For i = LBound(Tab1) To UBound(Tab1)
If Item = Tab1(i) Then
ii = ii + 1
Else
Item = Tab1(i)
ComboBox1.AddItem Item
ii = 1
End If
Next i
End Sub

Private Sub ComboBox1_Click()
Dim cell As Range
Dim r As Range
Dim i As Integer
Dim L As Long
ComboBox2.Clear
ComboBox3.Clear
ComboBox4.Clear
TextBox1 = 0
TextBox2 = 0
TextBox3 = 0
TextBox4 = ""

With WS1.Range("B5")
.AutoFilter 1, ComboBox1
.AutoFilter 2
.AutoFilter 3
.AutoFilter 4
.AutoFilter 5

End With
L = WS1.Range("C65536").End(xlUp).Row
If L = 6 Then GoTo Suite
Set r = WS1.Range("C6:C" & L)
Set r = r.SpecialCells(xlCellTypeVisible)
ReDim TabC(0 To r.Count - 1)
For Each cell In r
TabC(i) = cell.Value
i = i + 1
Next
TriTabC
DoublonTabC
Exit Sub
Suite:
ComboBox2.AddItem WS1.Range("C6")
End Sub
Sub TriTabC()
Dim ValMin As Integer, ValSup As Integer
Dim i As Integer, J As Integer, ii As Integer
Dim Tab1 As String
ValMin = LBound(TabC)
ValSup = UBound(TabC)
For i = ValMin To ValSup
For J = ValMin + ii To ValSup
If TabC(i) > TabC(J) Then
Tab1 = TabC(J)
TabC(J) = TabC(i)
TabC(i) = Tab1
End If
Next J
ii = ii + 1
Next i
End Sub
Sub DoublonTabC()
Dim i As Integer
Dim Item As String
Item = ""
For i = LBound(TabC) To UBound(TabC)
If Item = TabC(i) Then
Else
Item = TabC(i)
ComboBox2.AddItem Item
End If
Next i
End Sub

Private Sub ComboBox2_Click()
Dim cell As Range
Dim r As Range
Dim i As Integer
Dim L As Long
ComboBox3.Clear
ComboBox4.Clear
TextBox1 = 0
TextBox2 = 0
TextBox3 = 0
TextBox4 = ""


With WS1.Range("B5")
.AutoFilter 2, ComboBox2
.AutoFilter 3
.AutoFilter 4
.AutoFilter 5

End With
L = WS1.Range("D65536").End(xlUp).Row
If L = 6 Then GoTo Suite
Set r = WS1.Range("D6:D" & L)
Set r = r.SpecialCells(xlCellTypeVisible)
ReDim TabD(0 To r.Count - 1)
For Each cell In r
TabD(i) = cell.Value
i = i + 1
Next
TriTabD
DoublonTabD
Exit Sub
Suite:
ComboBox3.AddItem WS1.Range("D6")
End Sub

Sub TriTabD()
Dim ValMin As Integer, ValSup As Integer
Dim i As Integer, J As Integer, ii As Integer
Dim Tab2 As String
ValMin = LBound(TabD)
ValSup = UBound(TabD)
For i = ValMin To ValSup
For J = ValMin + ii To ValSup
If TabD(i) > TabD(J) Then
Tab2 = TabD(J)
TabD(J) = TabD(i)
TabD(i) = Tab2
End If
Next J
ii = ii + 1
Next i
End Sub
Sub DoublonTabD()
Dim i As Integer
Dim Item As String
Item = ""
For i = LBound(TabD) To UBound(TabD)
If Item = TabD(i) Then
Else
Item = TabD(i)
ComboBox3.AddItem Item
End If
Next i
End Sub



Private Sub ComboBox3_Click()
Dim cell As Range
Dim r As Range
Dim i As Integer
Dim L As Long
ComboBox4.Clear
TextBox1 = 0
TextBox2 = 0
TextBox3 = 0
TextBox4 = ComboBox3
With WS1.Range("B5")
.AutoFilter 3, ComboBox3
.AutoFilter 4
.AutoFilter 5
End With
i = 0
L = WS1.Range("E65536").End(xlUp).Row
If L = 6 Then GoTo Suite
Set r = WS1.Range("E6:E" & L)
Set r = r.SpecialCells(xlCellTypeVisible)

ReDim TabE(0 To r.Count - 1)

For Each cell In r
TabE(i) = cell.Value

i = i + 1
Next
TriTabE
DoublonTabE
Exit Sub
Suite:
ComboBox4.AddItem WS1.Range("E6")
End Sub


Sub TriTabE()
Dim ValMin As Integer, ValSup As Integer
Dim i As Integer, J As Integer, ii As Integer
Dim Tab3 As String
ValMin = LBound(TabE)
ValSup = UBound(TabE)
For i = ValMin To ValSup
For J = ValMin + ii To ValSup
If TabE(i) > TabE(J) Then
Tab3 = TabE(J)
TabE(J) = TabE(i)
TabE(i) = Tab3
End If
Next J
ii = ii + 1
Next i
End Sub

Sub DoublonTabE()
Dim i As Integer
Dim Item As String
Item = ""
For i = LBound(TabE) To UBound(TabE)
If Item = TabE(i) Then
Else
Item = TabE(i)
ComboBox4.AddItem Item
End If
Next i
End Sub


Private Sub ComboBox4_Click()
Dim CTRL As Control
Dim cell As Range
Dim r As Range
Dim i As Integer
Dim L As Long
For Each CTRL In Controls
If CTRL.Tag = "C" Then CTRL.Visible = True
Next
TextBox2 = 1
TextBox3 = ""
WS1.Range("B5").AutoFilter 4, ComboBox4
L = WS1.Range("F65536").End(xlUp).Row
If L = 6 Then GoTo Suite
Set r = WS1.Range("F6:F" & L)
Set r = r.SpecialCells(xlCellTypeVisible)


For Each cell In r
TextBox1 = cell.Value



i = i + 1
TextBox3 = CDbl(TextBox1) * CDbl(TextBox2)

Next
If i > 1 Then
MsgBox "Vous avez un doublon dans vos articles", vbInformation
WS1.Activate
End If
Exit Sub
Suite:
TextBox1 = WS1.Range("F6")
TextBox3 = CDbl(TextBox1) * CDbl(TextBox2)
End Sub

Private Sub TextBox1_Change()
If Not IsNumeric(TextBox1) Then
With TextBox1
.SetFocus
.Value = 0
End With

MsgBox "Entrez uniquement des valeur numériques", vbCritical, "Thierry's Démo"
Exit Sub
End If
TextBox3 = CDbl(TextBox1) * CDbl(TextBox2)
End Sub



Private Sub SpinButton1_Change()

TextBox2 = SpinButton1

If TextBox1 = "" Or TextBox1 = 0 Then Exit Sub
TextBox3 = CDbl(TextBox1) * CDbl(TextBox2)

End Sub

Private Sub CommandButton1_Click()
WS2.Activate
L = WS2.Range("B65536").End(xlUp).Row + 1
ReportDonnees
End Sub


Private Sub CommandButton2_Click()
WS1.AutoFilterMode = False
Unload Me
End Sub

Private Sub CommandButton3_Click()
WS2.Activate
L = WS2.Range("B65536").End(xlUp).Row + 1
UserForm4.Show
End Sub
 

Pièces jointes

  • Capture.jpg
    Capture.jpg
    21.9 KB · Affichages: 62
  • Capture.jpg
    Capture.jpg
    21.9 KB · Affichages: 59
  • Capture.jpg
    Capture.jpg
    21.9 KB · Affichages: 60

MJ13

XLDnaute Barbatruc
Re : inserer photos dans unserform suivant combobox

Bonjour David

Ton fichier en retour avec un bouton Insère Image dans le USF3 à adapter.

Tu places les 2 fichiers sur ton bureau.
 

Pièces jointes

  • devis et facture version 14_BoutonImage.xlsm
    262.5 KB · Affichages: 64
  • J0099188.JPG
    J0099188.JPG
    8.9 KB · Affichages: 41

davidg

XLDnaute Nouveau
Re : inserer photos dans unserform suivant combobox

bonjour

j ai oublier de dire que mes images se trouve dans le dossier

C:\Users\utilisateur\Documents\A.L.D\facturation\photos matos

de plus je suis novice dans la programmation

comment faire pour ecrire le code corrsctement

cordialement
 

MJ13

XLDnaute Barbatruc
Re : inserer photos dans unserform suivant combobox

Re

Sinon, voir ce fichier et adapter Thisworkbook.Path par le bon nom de dossier.
 

Pièces jointes

  • Desktop.zip
    276 KB · Affichages: 60
  • Desktop.zip
    276 KB · Affichages: 66
  • Desktop.zip
    276 KB · Affichages: 63

davidg

XLDnaute Nouveau
Re : inserer photos dans unserform suivant combobox

bonjour

merci pour ton aide

le fichier fonctionne tres bien

parfois il me faut du temps pour comprendre


Private Sub TextBox4_Change()

Dim chemin As String
On Error GoTo absent
'on definie une variable en taille, le dim au dessus, et sa valeur, la ligne en dessous
chemin = TextBox4.Value 'donc chemin = bougies
'pour afficher l'image, nous avons la ligne suivante
UserForm3.Image1.Picture = LoadPicture("C:\Users\utilisateur\Documents\A.L.D\facturation\photos matos\" & chemin & ".JPG")
'ou nous retrouvons le repertoire par defaut des images et notre variable

'une petite gestion d'erreur au cas ou l'image n'est pas trouvé
absent: MsgBox "la photo demandé n'est pas disponible"
End Sub


merci encore

cordialement
 

Discussions similaires

Réponses
11
Affichages
286
Réponses
29
Affichages
918

Statistiques des forums

Discussions
312 198
Messages
2 086 114
Membres
103 121
dernier inscrit
SophieS