Discussion :

[jimbo4215]

Bonsoir à tous,

j'aimerais savoir si vous pensez que c'est possible d'insérer une image dans une cellule défini dans tous les classeurs présents dans un dossier ?

Il y aurait un fichier maitre avec un bouton pour lancer la macro et au lancement ca :

1 prend connaissance de la photo
2 prends connaissance de tous les fichiers du dossier
3 insère l'image dans A1 avec une certaine taille


avez vous des pistes si c'est réalisable ?


Merci

[tototiti2008]

Bonjour jimbo,

Oui
ça devra ouvrir chaque fichier, coller ou insérer ta photo, l'enregistrer puis le fermer avant de passer au suivant
réalisable mais probablement long à l'exécution

[Qwazerty]

Salut

Voila une contribution qui te permettra d'obtenir un tableau contenant le listing des fichiers contenus dans le répertoire spécifié.
http://www.developpez.net/forums/d89...nu-repertoire/


N'hésite pas à faire des recherches sur le thème "Insérer image dans fichier" (ou approchant), j'ai déjà vu/participé à des discussions sur le sujet.


++
Qwaz

[clementmarcotte]

Bonjour,

C'est impossible de mettre une image dans une cellule. On peut tout au mieux la placer sur une feuille déterminée, mais jamais dans une cellule.

[parmi]

Bonjour,

avez vous des pistes si c'est réalisable ?

Oui... l'enregistreur de macro peut-être ?
Qui te donnerait un code du genre

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
    ActiveSheet.Shapes("Picture 1").Copy    'copier l'image nommée Picture 1
    Workbooks.Add                           'Crée un classeur. Ici on pourrait ouvrir le fichier qu'on veut
    Range("B3").Select                      'sélectionne la cellule où coller
    ActiveSheet.Paste                       'colle l'image
    Selection.ShapeRange.ScaleWidth 0.75, msoFalse, msoScaleFromTopLeft  'redimensionne à 75%

Pour ce qui est de lire/ouvrir les fichiers, il y a pas mal d'exemples sur ce forum...

Où est-ce que tu bloques exactement ?

[jimbo4215]

Salut

Voila une contribution qui te permettra d'obtenir un tableau contenant le listing des fichiers contenus dans le répertoire spécifié.
http://www.developpez.net/forums/d89...nu-repertoire/


N'hésite pas à faire des recherches sur le thème "Insérer image dans fichier" (ou approchant), j'ai déjà vu/participé à des discussions sur le sujet.


++
Qwaz

j'ai commencé le fichier maitre il est en pièce jointe en faite dans la liste des fichiers il faudrait que ça remonte tous les noms de fichiers du dossier pour commencer

[tototiti2008]

Bonsoir à tous

Pour commencer alors

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub ChercheFic()
Dim Doss As String, Lig As Long, Col As Long, Fic As String
    With ThisWorkbook.Worksheets("Fichiers")
        Doss = .Range("chemin").Value
        Lig = .Range("tableauxls").Row + 1
        Col = .Range("tableauxls").Column
        Fic = Dir(Doss & "*.xls*")
        Do Until Fic = ""
            .Cells(Lig, Col).Value = Fic
            Fic = Dir
            Lig = Lig + 1
        Loop
    End With
End Sub

[jimbo4215]

Salut à tous

parfait déjà une première chose qui fonctionne, je lance le VBA et il me collecte tous les noms.

je pense que le plus dure reste à vanir pour aller copier mon Koala.jpg dans tous les noms trouvés

[patricktoulon]

on insert pas une image dans une cellule mais on peut la placer au même endroit et avec la même dimension ce qui visuellement donne l'illusion que la photo est dans la cellule
fait une recherche sur topleftcell ,sur AddPicture ou sur Pictures.Insert

2 exemple pour inserer une image dans un sheets
avec picture.insert

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Sub insert_image()
    Dim sh As Worksheet, im As Picture
    Set sh = ActiveSheet
    Set im = sh.Pictures.Insert("C:\Users\Public\Pictures\Sample Pictures\Koala.jpg")
    Set cel = Range("G2:G3")
    With im
         .Left = cel.Left
        .Top = cel.Top
         'l'image reste a l'interieur  de la plage mais garde son aspect ration
         .Width = cel.Width
        .Height = cel.Height
    End With
End Sub

avec addpicture

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Sub ADD_image()
Set cel = Range("D6:D7")
Dim sh As Worksheet, im As Shape
Set sh = ActiveSheet
'l'image est ajoutée et dimentionnée au dimention égale a la plage ou cellule en parametre
' ce qui implique  une perte de l'aspect ration
Set im = sh.Shapes.AddPicture("C:\Users\Public\Pictures\Sample Pictures\Koala.jpg", msoFalse, msoCTrue, cel.Left, cel.Top, cel.Width, cel.Height)
End Sub

[jimbo4215]

Merci ça fonctionne bien ! elle s’insère.

Il faut maintenant écrire une boucle qui va l’insérer dans tous les fichiers découverts ? avec Workbooks.Open ?

[patricktoulon]

oupss!!!!
j'en avais oublier une
il y a un 3 eme moyen d'insérer une image dans le sheets
en ajoutant un shapes rectangle(forme automatique)
et en le remplissant d'une image

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub test3()
Set cel = Range("D6:D7")
Dim sh As Worksheet, im As Shape
Set sh = ActiveSheet
'l'image est ajoutée et dimentionnée au dimention égale a la plage ou cellule en parametre
' ce qui implique  une perte de l'aspect ration
Set im = sh.Shapes.AddShape(1, cel.Left, cel.Top, cel.Width, cel.Height) 'on ajoute une shape rectangle au dimentions de la plage
im.Fill.UserPicture ("C:\Users\Public\Pictures\Sample Pictures\Koala.jpg") ' on la rempli avec une image du disque dur
im.Line.Visible = False 'on elenve le cadre autour de la shape 
End Sub

pour la boucle c'est simple avec l'instruction "dir "

[jimbo4215]

vous pourriez m'aider pour la boucle ?

Merci

[keygen08]

Bonsoir

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Sub CommandButton20()
'necessite d'activé Microsoft Scripting Runtime
'Necessite l'activation de la reference Microsoft Windows Image Acquisition Library V2.00
Static FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim File As Scripting.File
Dim Img As WIA.ImageFile, IP As WIA.Imageprocess
Dim photo As Variant
 
    Set Img = CreateObject("WIA.ImageFile")   'Création conteneur pour l'image à coller
    photo = Application.GetOpenFilename("Fichiers Images (*.jpg),*.jpg", , "double cliquer sur une image", , False)
    Img.LoadFile photo 'Chargement de l'image dans le conteneur
 
    Set FSO = CreateObject("Scripting.FileSystemObject") 'pour la manipulation du repertoire
    rep_source = Application.GetOpenFilename("Fichiers excel (*.xls),*.xls", , "Choisir les fichiers excel a ouvrir", , True)
    If IsArray(rep_source) Then
    Set cls = Application.Workbooks.Open(rep_source(1))
 
With cls.Sheets(1).Range("a1")
        Gauche = .Left
        Sommet = .Top
        Largeur = .Width
        Hauteur = .Height
        End With
        cls.Sheets(1).Shapes.AddPicture photo, True, True, Gauche, Sommet, Largeur, Hauteur
    End If
 
End Sub

Je vous laisse boucler sur les classeurs du repertoire si le choix des fichiers ou coller l'image l'image se revele fastidieuse
Ou je le ferais peut etre, mais beaucoup, beaucoup de travail en ce moment et peu de disponibilité.

[patricktoulon]

bonjour keygen

veux tu bien m'expliquer a quoi sert ton Object wia instancié dans ton code
pour moi il sert a rien c'est sur même !!!!

ensuite :
pourquoi instancier des object fso,scripting puisque tu ne t'en sert pas et que tu te sert des boites de dialog intégré a l'application ????????,

bref j'ai mis presque tout mis en vert et ca fonctionne encore c'est pour te dire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Sub CommandButton20()
'necessite d'activé Microsoft Scripting Runtime
'Necessite l'activation de la reference Microsoft Windows Image Acquisition Library V2.00
'Static FSO As Scripting.FileSystemObject
'Dim SourceFolder As Scripting.Folder
'Dim File As Scripting.File
'Dim Img As WIA.ImageFile, IP As WIA.Imageprocess
Dim photo As Variant
 
    'Set Img = CreateObject("WIA.ImageFile")   'Création conteneur pour l'image à coller
    photo = Application.GetOpenFilename("Fichiers Images (*.jpg),*.jpg", , "double cliquer sur une image", , False)
    'Img.LoadFile photo 'Chargement de l'image dans le conteneur
 
    'Set FSO = CreateObject("Scripting.FileSystemObject") 'pour la manipulation du repertoire
    rep_source = Application.GetOpenFilename("Fichiers excel (*.xls),*.xls", , "Choisir les fichiers excel a ouvrir", , True)
    If IsArray(rep_source) Then ' tu veux bien m'expliquer ca aussi
    'pourquoi tester si c'est un array ??????????
    Set cls = Application.Workbooks.Open(rep_source(1))
 
With cls.Sheets(1).Range("a1")
        'Gauche =
        'Sommet =
        'Largeur =
        'Hauteur =
 
        cls.Sheets(1).Shapes.AddPicture photo, True, True, .Left, .Top, .Width, .Height
    End With
    End If
 
End Sub

[keygen08]

Bonsoir Patrick
Je sais, je l'ai fait un peu a l'arrache hier soir.
Exemple a ne pas suivre.
Parti sur une idée, j'ai virer en court de route et pas vraiment nettoyer.

[jimbo4215]

ça ne fonctionne pas malgré tout la boucle, ça colle l'image sur seulement un document même si je les ouvre tous

j'aurais bien continué avec une boucle Dim

Merci