Application.GetOpenFilename + ThisWorkbook.Path Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
Répondre
t
thomas67
Membre fidèle
Membre fidèle
Messages : 201
Inscrit le : 1 octobre 2012
Version d'Excel : 2010

Message par thomas67 » 29 mai 2017, 14:39

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
Avatar du membre
i20100
Passionné d'Excel
Passionné d'Excel
Messages : 6'036
Appréciations reçues : 352
Inscrit le : 16 mars 2017
Version d'Excel : 2010

Message par i20100 » 31 mai 2017, 21:05

Bonjour,
'...
ChDir ThisWorkbook.Path
Fichier = Application.GetOpenFilename(FileFilter:="Pictures, *.jpg; *.png; *.gif; *.tif; *.tiff; *.bmp", Title:=" ", MultiSelect:=False)

'...
1 membre du forum aime ce message.
Prenons soins de nous et de notre vaisseau spatial, nous n’en n’avons qu’un ...notre planète terre
isabelle
p
pierre.jy
Membre fidèle
Membre fidèle
Messages : 499
Appréciation reçue : 1
Inscrit le : 26 février 2016
Version d'Excel : 2010

Message par pierre.jy » 31 mai 2017, 21:35

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 ;)
1 membre du forum aime ce message.
Répondre
  • Sujets similaires
    Réponses
    Vues
    Dernier message