XL 2013 Insertion image (arrivée sur proposition "bureau")

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonjour à toutes et à tous,

LOL, ça fait longtemps.
Faut dire que je suis en permanence ou presque connecté et que je trouve beaucoup de solutions que j'adapte à mes besoins et je ne vous en remercierai jamais assez.

J'ai un nouveau souci et, malgré mes tentatives et recherches sur le site, chez Mr Boisgontier et sur le web, je n'ai pas trouvé le bon code.

Mon besoin :
Je voudrais importer dans une feuille excel une image qui n'est jamais la même et qui peut être dans différents dossiers sur mon ordi.

L'enregistreur de macros m'oblige à définir un chemin
Tous les codes que j'ai trouvé insère une image toujours en codant un chemin.

Je n'arrive pas à faire un code qui m'anène tout simplement sur le bureau " Desktop".

Auriez-vous le bon code ?
Fichier test joint,

Avec mes remerciements,
Je vous souhaite une très bonne journée à toutes et à tous,
Amicalement,
Arthour973
 

Pièces jointes

Re Lionel

Je viens d'adapter le code et ça joue.

VB:
Option Explicit

Sub test()
Dim utilisateur As String, bdd As Variant, pos As Range, pict As Shape

    bdd = Application.GetOpenFilename("Tous les fichiers (*.*),*.*")
    utilisateur = Environ("Username")

    If bdd = False Then Exit Sub

    ActiveSheet.Pictures.Insert(bdd).Name = utilisateur
    Set pos = ActiveSheet.Range("c5")
    Set pict = ActiveSheet.Shapes(utilisateur)
  
    With pict
        .Left = pos.Left
        .Top = pos.Top
        .Height = pos.Height
        .Width = pos.Width

        .Placement = xlMove
        If .Height <> pos.Height Then
            .Height = pos.Height:
            .LockAspectRatio = msoFalse
        End If

        If .Width <> pos.Width Then
            .Width = pos.Width:
            .LockAspectRatio = msoTrue
        End If
    End With

End Sub
 
Bonjour Lolote83, Mr Boisgontier, Lone,

J'ai pris le temps de tester vos codes et ils fonctionnent nickel (un grand merci) à un poil près LOL

Code de Lolote et de Lone :
L'image (ou photo) s'insère bien aux dimensions de la plage voulue mais ne respecte pas les proportions.

Code de Mr Boisgontier :
- L'image (ou photo) s'insère bien aux dimensions de la plage voulue et respecte les proportions si l'image n'est pas plus grande que les cellules destinataires,

- NE MET PAS AUX DIMENTIONS cellules destinataires si la photo est plus grande.

Je joins le fichier joint avec exemples.

Est-il possible de résoudre ce "petit" souci ?

Avec mes remerciements,
Je vous souhaite un bon WE à toutes et à tous 😉
Amicalement,
Arthour973,
 

Pièces jointes

Dernière édition:
Re,

Je viens de faire un test avec ceci, mais je ne sais pas si c'est ça que tu veux.

VB:
Sub test()
    Set pos = ActiveSheet.Range("h4").MergeArea
    Set pict = ActiveSheet.Pictures

    With pict
        .Left = pos.Left
        .Top = pos.Top
        .Height = pos.Height
        .Width = pos.Width
        If .Height <> pos.Height Then
            .Height = pos.Height:
            .ShapeRange.LockAspectRatio = msoFalse
        End If

        If .Width <> pos.Width Then
            .Width = pos.Width:
            .ShapeRange.LockAspectRatio = msoTrue
        End If
    End With
End Sub
 
LOL, oh que oui, j'ai passé ma matinée à tout tester et à chercher
En fait, ton code marche bien mais n'insère pas l'image dans la plage sélectionnée en respectant les proportions.
Ne t'embête pas, ce n'est pas si grave.
Déjà un grand merci 😉
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
742
Réponses
40
Affichages
2 K
Retour