Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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" & 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
    21.9 KB · Affichages: 63
  • Capture.jpg
    21.9 KB · Affichages: 60
  • Capture.jpg
    21.9 KB · Affichages: 61

davidg

XLDnaute Nouveau
Re : inserer photos dans unserform suivant combobox

bonjour


merci pour votre reponse
voici le fichier que javais oublier de mettre en ligne

cordialement
 

Pièces jointes

  • devis et facture version 14.xlsm
    292.3 KB · Affichages: 48

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
    8.9 KB · Affichages: 42

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
304
Réponses
29
Affichages
969
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…