Import de (données et image) d'un fichier excel à un autre

Bonjour à tous,

J'ai réalisé un formulaire de saisie, cependant, ce formulaire dépend de données issus d'un autre fichier.

J'ai donc décidé d'effectué un import de la Base de données (BDD) de ce fichier vers mon classeur formulaire afin d'exploiter les données.

Avec mon code, j'arrive bien à copier les données de la BDD à mon formulaire, cependant, j'ai du mal à copier les images contenues dans les cellules de la colonne C de la BDD.

Voici mon code d'import (en bleu le code à corriger et en rouge le moment où le code s'arrête de fonctionner...):

Code:

---

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 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55

Private Sub UserForm_Initialize() 'Initialisation de l'userform "Mise en forme" 'On Error Resume Next Application.DisplayAlerts = False Application.DisplayFullScreen = True Application.DisplayExcel4Menus = False Application.DisplayFormulaBar = False Application.DisplayStatusBar = False ActiveWindow.DisplayHorizontalScrollBar = False ActiveWindow.DisplayVerticalScrollBar = False '---------------------------------------------------------------Import de la BDD depuis le chemin indiqué----------------------------------------------------------------- 'Initialisation des variables de traitements Dim repertoire As String, Fichier As String Dim DateModifFichier As Date repertoire = Workbooks("Relevés dimensionnels.xlsb").Sheets("Reglages").Range("I12").Value 'Si il n'y a pas de fichier dans le répertoire alors ... If repertoire = "" Then MsgBox "La base de données est introuvable." & Chr(10) & "Merci d'entrer à nouveau le chemin de destination de la base de données depuis le menu 'Réglages' (Roue crantée)", vbCritical GoTo ici End If 'Ouverture du fichier Workbooks.Open (repertoire) '----------------------------Récupération du range de la BDD permettant de copier-coller intégralement les données externes :---------------------------------------------- 'i correspond à la dernière ligne de la colonne A de la BDD i = Workbooks(2).Sheets("BDD").Range("A" & Rows.Count).End(xlUp).Row 'j correspond à la dernière colonne de la BDD nbcol = Workbooks(2).Sheets("BDD").Cells(1, Cells.Columns.Count).End(xlToLeft).Column 'on récupère le numéro de la dernière colonne j = Split(Cells(1, nbcol).Address, "$")(1) 'on convertir le numéro en "lettre Colonne" 'k correspond à la dernière ligne de la dernière colonne de la BDD k = Workbooks(2).Sheets("BDD").Range(j & Rows.Count).End(xlUp).Row 'On recupère le numéro de la dernière ligne (dernière colonne) 'Voici le copier/coller des données du formulaire en direction de la BDD (données) Workbooks(1).Sheets("BDD").Range("A" & i & ":" & j & k).Value = Workbooks(2).Sheets("BDD").Range("A" & i & ":" & j & k).Value 'Voici le copier/coller des images du formulaire en direction de la BDD (images) For Each cel In Workbooks(2).Sheets("BDD").Range("C:C") l = cel.Row cel.CopyPicture xlScreen, xlBitmap Workbooks(1).Sheets("BDD").Range("C" & l).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True Next Workbooks(2).Close ici: 'Reste du code ....

---

Merci d'avance de votre aide !!

Cordialement.

GK

Bonjour,

Les images et autres éléments graphiques ne sont pas liés, ni situés dans des cellules. Ils sont dans la feuille. Tu ne peux pas copier une image en passant par une cellule, ni coller une image dans une cellule. Là, je n'ai pas envie de chercher, mais regarde à partir de l'objet Worksheet dans l'aide de VBA

Ahhhh ! Tout s'explique !! Je pensais que les images étaient stockées dans les cellules ... et non dans la feuille...

Et si dans une boucle "For each Picture in range tatati..." je passe toutes les images de la feuille depuis la boucle et que j'effectue un coller sur la feuille, ça peut marcher ?

Je vais regarder ça de plus près, je posterai ici la solution.

Merci !!

GK

Alors après recherche, ce code fonctionne :

Code:

---

1 2 3 4 5 6 7 8 9 10

Dim Nb As String Dim Img As Shape   With Workbooks(2).Sheets("BDD") Nb = ActiveSheet.Shapes.Count For Each Img In ActiveSheet.Shapes Img.Copy Workbooks(1).Sheets("BDD").Paste Next Img End With

---

Le souci c'est que cela copie bien les images d'une feuille à l'autre, mais..... Pas dans une cellule (mais plutôt sauvagement sur la page, n'importe où !)

Une idée pour résoudre ce problème ??

J'aimerai qu'une image copier d'une cellule C1 se retrouve sur l'autre feuille en cellule C1 également avec la même position ... ??

Merci d'avance.

GK

J'ai trouvé ça en cherchant un peu, mais c'est pas terrible ... :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17

With Workbooks(2).Sheets("BDD") For Each Img In ActiveSheet.Shapes L = Img.Left T = Img.Top w = Img.Width H = Img.Height N = Img.Name   Img.Copy Workbooks(1).Sheets("BDD").Paste   Workbooks(1).Sheets("BDD").Shapes(N).Left = L Workbooks(1).Sheets("BDD").Shapes(N).Top = T Workbooks(1).Sheets("BDD").Shapes(N).Width = w Workbooks(1).Sheets("BDD").Shapes(N).Height = H Next Img End With

---

Mieux encore :

Code:

---

1 2 3 4 5 6 7

'Copier/coller des images du range (C:C) Workbooks(2).Sheets("BDD").Activate Columns("C:C").Select Selection.Copy Workbooks(1).Sheets("BDD").Activate Columns("C:C").Select ActiveSheet.Paste

---