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...):
Merci d'avance de votre aide !!
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 ....
Cordialement.
GK
Partager