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 : 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
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