Button selectioner photo (pc), enregistrer dans répertoire

Bonjour, et merci d’avance pour l’efforce que vous faite pour nous les nuls

Je voudrai attribuer a ma CommandButton19_Click , un code qui me permettrait d’ouvrir une fenêtre parcourir et choisir une photo dans mon ordi, et l’enregistrer dans mon répertoire ( ThisWorkbook.Path & "\Information\Photos\Userform"), la photos doit être nommé comme la TextBox14.

Option Explicit

Private Sub CommandButton17_Click()
Dim Chemin1 As String

Chemin1 = ThisWorkbook.Path & "\Information\Photos\Userform\" & TextBox14.Text & ".jpg"
Shell "C:\windows\explorer.exe " & Chemin1, vbMaximizedFocus

End Sub

Private Sub CommandButton18_Click()

If ListBox1.ListIndex <> -1 Then
Sheets("BDD").Activate
Sheets("BDD").Rows(Me.ListBox1.List(Me.ListBox1.ListIndex)).Activate
Unload Me
End If

End Sub

Private Sub CommandButton19_Click()

End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub CommandButton3_Click()
Unload Me
UserForm1.Show
End Sub

Private Sub CommandButton4_Click()

Dim Prem As String
Dim c As Range

With Me.ListBox1
    .Clear
    .ColumnCount = 2
    .BoundColumn = 2
    .ColumnWidths = "0;150"
End With

With Worksheets("BDD").UsedRange
    Set c = .Find(Me.TextBox14, LookIn:=xlValues, Lookat:=xlPart)
    If Not c Is Nothing Then
        Prem = c.Address
        Do
            With Me.ListBox1
                .AddItem c.Row
                .List(.ListCount - 1, 1) = c.Offset(, 2 - c.Column)
            End With
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> Prem
    End If
End With

If ListBox1.ListCount = 0 Then
MsgBox "Ce matériel n'existe pas dans la base de données"
End If

End Sub

Private Sub CommandButton7_Click()

Dim Prem As String
Dim c As Range

With Me.ListBox2
    .Clear
    .ColumnCount = 2
    .BoundColumn = 2
    .ColumnWidths = "0;150"
End With

With Worksheets("personnel").UsedRange
    Set c = .Find(Me.TextBox2, LookIn:=xlValues, Lookat:=xlPart)
    If Not c Is Nothing Then
        Prem = c.Address
        Do
            With Me.ListBox2
                .AddItem c.Row
                .List(.ListCount - 1, 1) = c.Offset(, 1 - c.Column)
            End With
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> Prem
    End If
End With

If ListBox2.ListCount = 0 Then
MsgBox "Ce nom n'existe pas dans la base de données"
End If

End Sub

Private Sub CommandButton5_Click()

Dim yourmsgbox As Integer

yourmsgbox = MsgBox("Veuillez confirmer la suppression définitive du matériel", vbOKCancel, "confirmation")
If yourmsgbox = vbCancel Then
Exit Sub
Else
Sheets("BDD").Rows(Me.ListBox1.List(Me.ListBox1.ListIndex)).EntireRow.Delete
End If

Unload Me
UserForm1.Show

End Sub

Private Sub ListBox1_Change()

If ListBox1.ListIndex <> -1 Then
TextBox20 = Sheets("BDD").Range("A" & Me.ListBox1.List(Me.ListBox1.ListIndex))
TextBox8 = Sheets("BDD").Range("C" & Me.ListBox1.List(Me.ListBox1.ListIndex))
TextBox15 = Sheets("BDD").Range("D" & Me.ListBox1.List(Me.ListBox1.ListIndex))
TextBox13 = Sheets("BDD").Range("F" & Me.ListBox1.List(Me.ListBox1.ListIndex))
ComboBox1 = Sheets("BDD").Range("G" & Me.ListBox1.List(Me.ListBox1.ListIndex))
TextBox16 = Sheets("BDD").Range("E" & Me.ListBox1.List(Me.ListBox1.ListIndex))
Me.TextBox14.Text = Me.ListBox1.List(Me.ListBox1.ListIndex, 1)
CommandButton18.Enabled = True
CommandButton5.Enabled = True

CommandButton4.Enabled = True

TextBox15.Locked = True
TextBox15.BackColor = &HE0E0E0

TextBox13.Locked = True
TextBox13.BackColor = &HE0E0E0

ComboBox1.Locked = True
ComboBox1.BackColor = &HE0E0E0

TextBox16.Locked = True
TextBox16.BackColor = &HE0E0E0

OptionButton10.Enabled = True

OptionButton9.Enabled = True

OptionButton8.Enabled = True

OptionButton7.Enabled = True

TextBox2.Locked = False
TextBox2.BackColor = &H80000005

TextBox3.Locked = False
TextBox3.BackColor = &H80000005

TextBox6.Locked = False
TextBox6.BackColor = &H80000005

TextBox7.Locked = False
TextBox7.BackColor = &H80000005

Else
CommandButton4.Enabled = False

TextBox20 = ""
TextBox8 = ""
ListBox2.Clear
ListBox1.Clear

OptionButton10.Enabled = False
OptionButton10 = 0

OptionButton9.Enabled = False
OptionButton9 = 0

OptionButton8.Enabled = False
OptionButton8 = 0

OptionButton7.Enabled = False
OptionButton7 = 0

TextBox2.Locked = True
TextBox2 = ""
TextBox2.BackColor = &HE0E0E0

TextBox3.Locked = True
TextBox3 = ""
TextBox3.BackColor = &HE0E0E0

TextBox6.Locked = True
TextBox6 = ""
TextBox6.BackColor = &HE0E0E0

TextBox7.Locked = True
TextBox7 = ""
TextBox7.BackColor = &HE0E0E0

ScrollBar2.Enabled = False
ScrollBar2 = 0
TextBox12 = ""
TextBox12.BackColor = &HE0E0E0

OptionButton1.Enabled = False
OptionButton1 = 0

OptionButton2.Enabled = False
OptionButton2 = 0

OptionButton4.Enabled = False
OptionButton4 = 0

OptionButton11.Enabled = False
OptionButton11 = 0

CommandButton18.Enabled = False
CommandButton5.Enabled = False
End If

End Sub

Private Sub ListBox1_Click()

'### ajout/modif pmo
On Error Resume Next
Image1.Picture = LoadPicture(ThisWorkbook.Path & "\Information\Photos\Userform\" & TextBox14.Text & ".jpg")
CommandButton17.Visible = True
CommandButton19.Visible = False
If Err <> 0 Then
  Image1.Picture = LoadPicture(ThisWorkbook.Path & "\Information\Photos\Userform\" & "non photos.jpg")
  Me.CommandButton17.Visible = False
  CommandButton19.Visible = True
  End If
'###

End Sub

Private Sub ListBox2_Change()

If ListBox2.ListIndex <> -1 Then
TextBox3 = Sheets("personnel").Range("B" & Me.ListBox2.List(Me.ListBox2.ListIndex))
TextBox2.Text = ListBox2.Text

End If

End Sub

Private Sub OptionButton1_Change()

If OptionButton1 = True Then
TextBox9.BackColor = &H80000005
TextBox9.Locked = False

Else
TextBox9.BackColor = &HE0E0E0
TextBox9.Locked = True
TextBox9 = Application.WorksheetFunction.Max(Sheets("Ordredumouvement").Range("c3:c65536"))

End If
End Sub

Private Sub OptionButton10_Click()

If OptionButton10 = True Then
OptionButton1.Enabled = True
OptionButton2.Enabled = True
OptionButton4.Enabled = False
OptionButton11.Enabled = False
OptionButton4 = 0
OptionButton11 = 0
ScrollBar2.Enabled = True
ScrollBar2 = 0
TextBox12 = ""
TextBox12.BackColor = &H80000005

Else
OptionButton1 = 0
OptionButton2 = 0
OptionButton1.Enabled = False
OptionButton2.Enabled = False
ScrollBar2.Enabled = False
ScrollBar2 = 0
TextBox12 = ""
TextBox12.BackColor = &HE0E0E0

End If
End Sub

Private Sub OptionButton11_Change()

If OptionButton11 = True Then
TextBox19.BackColor = &H80000005
TextBox19.Locked = False

Else
TextBox19.BackColor = &HE0E0E0
TextBox19.Locked = True
TextBox19 = Application.WorksheetFunction.Max(Sheets("Ordredumouvement").Range("u3:u65536"))

End If
End Sub

Private Sub OptionButton2_Change()

If OptionButton2 = True Then
TextBox10.BackColor = &H80000005
TextBox10.Locked = False

Else
TextBox10.BackColor = &HE0E0E0
TextBox10.Locked = True
TextBox10 = Application.WorksheetFunction.Max(Sheets("Ordredumouvement").Range("i3:i65536"))

End If
End Sub

Private Sub OptionButton4_Change()

If OptionButton4 = True Then
TextBox11.BackColor = &H80000005
TextBox11.Locked = False

Else
TextBox11.BackColor = &HE0E0E0
TextBox11.Locked = True
TextBox11 = Application.WorksheetFunction.Max(Sheets("Ordredumouvement").Range("o3:o65536"))

End If
End Sub

Private Sub OptionButton8_Change()

If OptionButton8 = True Then
ScrollBar1.Enabled = True
TextBox5.BackColor = &H80000005

Else
ScrollBar1.Enabled = False
ScrollBar1 = 0
TextBox5 = Null
TextBox5.BackColor = &HE0E0E0

End If
End Sub

Private Sub OptionButton9_Change()

If OptionButton9 = True Then
OptionButton4.Enabled = True
OptionButton11.Enabled = True
OptionButton1.Enabled = False
OptionButton2.Enabled = False
OptionButton1 = 0
OptionButton2 = 0
ScrollBar2.Enabled = True
ScrollBar2 = 0
TextBox12 = ""
TextBox12.BackColor = &H80000005

Else
OptionButton4 = 0
OptionButton11 = 0
OptionButton4.Enabled = False
OptionButton11.Enabled = False
ScrollBar2.Enabled = False
ScrollBar2 = 0
TextBox12 = ""
TextBox12.BackColor = &HE0E0E0

End If
End Sub
Private Sub ScrollBar1_Change()
TextBox5 = ScrollBar1
End Sub
Private Sub ScrollBar2_Change()
TextBox12 = ScrollBar2
End Sub

Private Sub TextBox14_Change()

'### ajout/modif pmo
Image1.Picture = Nothing
Me.Repaint
'###

If TextBox14 <> "" Then

CommandButton4.Enabled = True

TextBox15.Locked = False
TextBox15.BackColor = &H80000005

TextBox13.Locked = False
TextBox13.BackColor = &H80000005 'blanc

ComboBox1.Locked = False
ComboBox1.BackColor = &H80000005 'blanc

TextBox16.Locked = False
TextBox16.BackColor = &H80000005 'blanc

OptionButton9.Enabled = True

OptionButton8.Enabled = True

OptionButton7.Enabled = True

TextBox2.Locked = False
TextBox2.BackColor = &H80000005

TextBox3.Locked = False
TextBox3.BackColor = &H80000005

TextBox6.Locked = False
TextBox6.BackColor = &H80000005

TextBox7.Locked = False
TextBox7.BackColor = &H80000005

Else
CommandButton4.Enabled = False

TextBox20 = ""
TextBox8 = ""
ListBox2.Clear
ListBox1.Clear

TextBox15.Locked = True
TextBox15 = ""
TextBox15.BackColor = &HE0E0E0

TextBox13.Locked = True
TextBox13 = ""
TextBox13.BackColor = &HE0E0E0

ComboBox1.Locked = True
ComboBox1 = ""
ComboBox1.BackColor = &HE0E0E0

TextBox16.Locked = True
TextBox16 = ""
TextBox16.BackColor = &HE0E0E0

OptionButton9.Enabled = False
OptionButton9 = 0

OptionButton8.Enabled = False
OptionButton8 = 0

OptionButton7.Enabled = False
OptionButton7 = 0

TextBox2.Locked = True
TextBox2 = ""
TextBox2.BackColor = &HE0E0E0

TextBox3.Locked = True
TextBox3 = ""
TextBox3.BackColor = &HE0E0E0

TextBox6.Locked = True
TextBox6 = ""
TextBox6.BackColor = &HE0E0E0

TextBox7.Locked = True
TextBox7 = ""
TextBox7.BackColor = &HE0E0E0

ScrollBar2.Enabled = False
ScrollBar2 = 0
TextBox12 = ""
TextBox12.BackColor = &HE0E0E0

OptionButton1.Enabled = False
OptionButton1 = 0

OptionButton2.Enabled = False
OptionButton2 = 0

OptionButton4.Enabled = False
OptionButton4 = 0

OptionButton11.Enabled = False
OptionButton11 = 0

CommandButton17.Visible = False
CommandButton19.Visible = False
End If

Me.TextBox9 = Application.WorksheetFunction.Max(Sheets("Ordredumouvement").Range("c3:c65536"))
Me.TextBox10 = Application.WorksheetFunction.Max(Sheets("Ordredumouvement").Range("i3:i65536"))
Me.TextBox11 = Application.WorksheetFunction.Max(Sheets("Ordredumouvement").Range("o3:o65536"))
Me.TextBox19 = Application.WorksheetFunction.Max(Sheets("Ordredumouvement").Range("u3:u65536"))

End Sub

Private Sub TextBox14_Enter()
TextBox14 = ""
End Sub

Private Sub TextBox2_Change()

If TextBox2 = "" Then
ListBox2.Clear
TextBox3 = ""
End If

Dim Prem As String
Dim c As Range

With Me.ListBox2
    .Clear
    .ColumnCount = 2
    .BoundColumn = 2
    .ColumnWidths = "0;150"
End With

If Me.TextBox2 <> "" Then
    With Worksheets("personnel").UsedRange
        Set c = .Find(Me.TextBox2, LookIn:=xlValues, Lookat:=xlPart)
        If Not c Is Nothing Then
            Prem = c.Address
            Do
                With Me.ListBox2
                    .AddItem c.Row
                    .List(.ListCount - 1, 1) = c.Offset(, 1 - c.Column)
                End With
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Prem
        End If
    End With
    '...
End If

End Sub

Private Sub UserForm_Activate()

Me.TextBox9 = Application.WorksheetFunction.Max(Sheets("Ordredumouvement").Range("c3:c65536"))
Me.TextBox10 = Application.WorksheetFunction.Max(Sheets("Ordredumouvement").Range("i3:i65536"))
Me.TextBox11 = Application.WorksheetFunction.Max(Sheets("Ordredumouvement").Range("o3:o65536"))
Me.TextBox19 = Application.WorksheetFunction.Max(Sheets("Ordredumouvement").Range("u3:u65536"))

End Sub
Private Sub Image1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

Dim Chemin1 As String
Chemin1 = ThisWorkbook.Path & "\Information\Photos\Userform"
Shell "C:\windows\explorer.exe " & Chemin1, vbMaximizedFocus

End Sub

Merci pour votre soutien

Rechercher des sujets similaires à "button selectioner photo enregistrer repertoire"