Application.GetOpenFilename + ThisWorkbook.Path
Bonjour à tous
merci par avance pour votre aide. Avec ce code j'ouvre une image, par contre j'aimerai que la fenêtre s'ouvre en montrant les fichiers qui sont dans le répertoire courant (ThisWorkbook.Path)
Voici mon code actuel:
Sub InsertionImage(Emplacement As String, nom As String, Nom2 As String)
Dim Fichier As Variant
Dim protec As Integer
Dim s As shape
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
If ActiveSheet.ProtectContents = True Then
protec = 1
Else
protec = 0
End If
Call Module1.unprotect_hide
Fichier = Application.GetOpenFilename(FileFilter:="Pictures, *.jpg; *.png; *.gif; *.tif; *.tiff; *.bmp", Title:=" ", MultiSelect:=False)
If Fichier = False Then GoTo no_image
On Error Resume Next ' en cas de bug, on ignore et passe à la suite
fichetechtrad.Shapes(nom).Delete ' efface l'image en place
fichetechtrad.Shapes(Nom2).Delete
information.Shapes(nom).Delete
information.Shapes(Nom2).Delete
prix.Shapes(nom).Delete
prix.Shapes(Nom2).Delete
production.Shapes(nom).Delete
production.Shapes(Nom2).Delete
etape.Shapes(nom).Delete ' et les formes, dessins plus bas dans la boucle
etape.Shapes(Nom2).Delete ' Dans les autres onglets aussi
For Each s In ActiveSheet.Shapes
If Not Intersect(s.TopLeftCell, Range(Emplacement)) Is Nothing Then
s.Select False
s.Delete
End If
Next s
On Error GoTo 0
On Error GoTo ErrorHandler
With ActiveSheet.Shapes.AddPicture(Fichier, True, True, Range(Emplacement).Left, Range(Emplacement).Top, Range(Emplacement).Width, Range(Emplacement).Height)
.Name = nom
End With
With fichetechtrad.Shapes.AddPicture(Fichier, True, True, Range(Emplacement).Left, Range(Emplacement).Top, Range(Emplacement).Width, Range(Emplacement).Height)
.Name = nom
End With
With production.Shapes.AddPicture(Fichier, True, True, Range(Emplacement).Left, Range(Emplacement).Top, Range(Emplacement).Width, Range(Emplacement).Height)
.Name = nom
End With
If nom = "Cible_b" Then
With prix.Shapes.AddPicture(Fichier, True, True, Range(Emplacement).Left + 75, Range(Emplacement).Top, Range(Emplacement).Width, Range(Emplacement).Height)
.Name = nom
End With
Else
With prix.Shapes.AddPicture(Fichier, True, True, Range(Emplacement).Left, Range(Emplacement).Top, Range(Emplacement).Width, Range(Emplacement).Height)
.Name = nom
End With
End If
With information.Shapes.AddPicture(Fichier, True, True, Range(Emplacement).Left, Range(Emplacement).Top, Range(Emplacement).Width, Range(Emplacement).Height)
.Name = nom
End With
With etape.Shapes.AddPicture(Fichier, True, True, Range(Emplacement).Left, Range(Emplacement).Top, Range(Emplacement).Width, Range(Emplacement).Height)
.Name = nom
End With
no_image:
If protec = 1 Then
Call Module1.protect_hide
End If
Application.ScreenUpdating = True
Exit Sub
ErrorHandler:
MsgBox Err.Number & vbLf & Err.Description
GoTo no_image
End Sub
Bonjour,
'...
ChDir ThisWorkbook.Path
Fichier = Application.GetOpenFilename(FileFilter:="Pictures, *.jpg; *.png; *.gif; *.tif; *.tiff; *.bmp", Title:=" ", MultiSelect:=False)
'...
p
Bonjour,
sabV a écrit :Bonjour,
'... ChDir ThisWorkbook.Path Fichier = Application.GetOpenFilename(FileFilter:="Pictures, *.jpg; *.png; *.gif; *.tif; *.tiff; *.bmp", Title:=" ", MultiSelect:=False) '...
rajoute un chDrive