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)

'...

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

Rechercher des sujets similaires à "application getopenfilename thisworkbook path"