XL 2019 Importer des images

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 !

Tsimbina

XLDnaute Junior
Bonjour à tous,
Existe-t-il déjà un fichier Excel, partagé sur ce forum, qui permet d'importer des images depuis un dossier de l'ordinateur dans des cellules spécifiques, tout en extrayant le nom de chaque image pour l'afficher dans une autre colonne ?
 
Dernière édition:
Solution
Re

@Tsimbina
Comme mon thé était trop chaud, je suis allé farfouillé dans mes archives 😉
Voici un exemple basique qui importe les images contenues dans un dossier que l'on sélectionne au départ de la macro.
Code:
Sub Importer_IMAGES_depuis_Dossier()
Dim DLog As FileDialog, Dossier$, Fic$, IMG$, r%, x%, y%, w%, h%
Set DLog = Application.FileDialog(4)
If DLog.Show = -1 Then
    Dossier = DLog.SelectedItems(1) & "\"
    Fic = Dir(Dossier)
    Do While Fic <> ""
        r = r + 1
        Cells(r, 2).Value = Fic
        With Cells(r, 1)
            .RowHeight = 57
            x = .Left
            y = .Top
            w = .Width
            h = .Height
        End With
        IMG = Dossier & Fic
        ActiveSheet.Shapes.AddPicture...
Re

@Tsimbina
Comme mon thé était trop chaud, je suis allé farfouillé dans mes archives 😉
Voici un exemple basique qui importe les images contenues dans un dossier que l'on sélectionne au départ de la macro.
Code:
Sub Importer_IMAGES_depuis_Dossier()
Dim DLog As FileDialog, Dossier$, Fic$, IMG$, r%, x%, y%, w%, h%
Set DLog = Application.FileDialog(4)
If DLog.Show = -1 Then
    Dossier = DLog.SelectedItems(1) & "\"
    Fic = Dir(Dossier)
    Do While Fic <> ""
        r = r + 1
        Cells(r, 2).Value = Fic
        With Cells(r, 1)
            .RowHeight = 57
            x = .Left
            y = .Top
            w = .Width
            h = .Height
        End With
        IMG = Dossier & Fic
        ActiveSheet.Shapes.AddPicture IMG, 0, -1, x, y, w, h
        Fic = Dir
    Loop
End If
ActiveSheet.Cells(1).CurrentRegion.Columns.AutoFit
End Sub
NB: Test OK sur mon PC ( W10 + Office 365)
 
Re

@Tsimbina
Comme mon thé était trop chaud, je suis allé farfouillé dans mes archives 😉
Voici un exemple basique qui importe les images contenues dans un dossier que l'on sélectionne au départ de la macro.
Code:
Sub Importer_IMAGES_depuis_Dossier()
Dim DLog As FileDialog, Dossier$, Fic$, IMG$, r%, x%, y%, w%, h%
Set DLog = Application.FileDialog(4)
If DLog.Show = -1 Then
    Dossier = DLog.SelectedItems(1) & "\"
    Fic = Dir(Dossier)
    Do While Fic <> ""
        r = r + 1
        Cells(r, 2).Value = Fic
        With Cells(r, 1)
            .RowHeight = 57
            x = .Left
            y = .Top
            w = .Width
            h = .Height
        End With
        IMG = Dossier & Fic
        ActiveSheet.Shapes.AddPicture IMG, 0, -1, x, y, w, h
        Fic = Dir
    Loop
End If
ActiveSheet.Cells(1).CurrentRegion.Columns.AutoFit
End Sub
NB: Test OK sur mon PC ( W10 + Office 365)
Merci beaucoup pour ton aide!!!
 
Re

@sousou
[pour info]
Dans ton appli, j'avais dans les références de VBE
[X] MANQUANT : Microsoft Windows Common Controls-2 6.0 (SP6)
(Sans doute, parce que sous Office 64 bits)
J'ai décoché et j'ai mis en commentaires le code de l'userform : userrecherche
Ce faisant j'évite l'affichage de l'erreur indiquée par @Tsimbina

Tu fais référence à MSCOMCT2.OCX dans ton appli ?
[/pour info]
 
Re

@sousou
[pour info]
Dans ton appli, j'avais dans les références de VBE
[X] MANQUANT : Microsoft Windows Common Controls-2 6.0 (SP6)
(Sans doute, parce que sous Office 64 bits)
J'ai décoché et j'ai mis en commentaires le code de l'userform : userrecherche
Ce faisant j'évite l'affichage de l'erreur indiquée par @Tsimbina

Tu fais référence à MSCOMCT2.OCX dans ton appli ?
[/pour info]
Effectivement j'utilise un calendar ' mscomct2', on peux modifier les deux textbox calendar avec autre chose
Je peux pas en ce moment,
 
- 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
4
Affichages
625
Réponses
1
Affichages
447
Compte Supprimé 979
C
Retour