[VBA-E] Transfert D'images Entre Deux Fichiers Excel

Version imprimable

05/04/2007, 10h00
Kevin_18

[VBA-E] Transfert D'images Entre Deux Fichiers Excel

Bonjour,

J'ai besoin pour mon boulot d'un petit renseignement!
J'ai 300 fichiers Excel tous selon la même forme :
Une image en feuille 2 appelé "Image 24".

J'aimerais pour chacun des fichiers (pour i=1 à 300) :
- copier l'image
- ouvrir un fichier Excel appelé Modèle
- coller l'image dans un PictureBox qui est dans le Modele
- enregistrer le Modele sous le nom Engrais i.

Etant donné le nombre important de fichiers, il est impossible de le faire à la main, bien entendu! Mon problème est dans le copier coller de l'image!

Auriez vous une soluce?
Merci d'avance.

Kevin.
05/04/2007, 10h06
ouskel'n'or

Ton image est-elle dans un contrôle "Image" ou est-elle directement collée sur la feuille ?
05/04/2007, 13h23
Kevin_18

Precision

Il s'agit d'images collés sur la feuille (donc pas dans un controle "Image")!
Merci pour ton intérêt!

Kevin.

Code:

1
2
3
4
5
6
7
8
Sub CopierCollerLimage()
    Workbooks("Classeur1").Worksheets("feuil1").Activate
    ActiveSheet.Shapes("Picture 1").Select
    Selection.Copy
    Windows("Classeur2").Activate
    Range("F9").Select
    ActiveSheet.Paste
End Sub

Brut d'enregistrement de macro en faisant, à peine modifié ;)
Testé -> Ok pour moi

Non ca va pas en fait parce que tu fais comme si tu connaissait le nom de ton fichier ou il faut prendre l'image (classeur1). Or, j'ai 300 noms différents correspondant aux 300 fichiers différents donc je l'ai paramétré.

Voici ton code adapté à mon pb :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 Set app = CreateObject("excel.application") app.Workbooks.Open "G:\PROJET\" & Nom & ".xls" 'J'ouvre une application EXCEL dont le nom de fichier est dans la variable Nom '(je fais ca 300 fois avec un nom différent à chaque fois, cela ca marche = Vérifié) Set classeur = app.Workbooks.Item(1) Set f = classeur.Worksheets.Item(2) 'Je definis le classeur et la feuille f.Activate ActiveSheet.Shapes("Image 24").Select '------)PROBLEME : IL NE TROUVE PAS L'IMAGE QUI EST BIEN DANS LE FICHIER SOUS CE NOM Selection.Copy Windows("Modele").Activate Range("A1").Select ActiveSheet.Paste