Bonjour à toutes et tous,
Je remercie particulièrement ceux grace auxquels j'ai pu construire le code suivant qui fonctionne parfaitement, à un détail prêt :
Voici le code :
Mon souci est le suivant : j'insère de 1 à 9 photos sur un enregistrement, (donc je répète ce code de 1 à 9 fois pour l'enregistrement d'un livre, un code par cadre Vuimage) mais si je veux supprimer une photo, je supprime automatiquement les autres. Ce qu'évidemment je ne souhaite pas. Ce système m'a imposé la création de 38 colonnes ID(num Auto), RefImag53(qui est la référence du livre du type LPRC1, LDRC2...) et 9 fois 4 colonnes (Nom d'image concaténer 1,2,3...) et les colonnes d'adressage : export, hd et vignet.
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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158 Option Compare Database Option Explicit 'GESTION DES IMAGES, RENOMMER, COPIER & DUPLIQUER (IMAGE 1) (Répéter jusqu'à 9 images) '============================================================= 'Déclaration des variables Private Sub Img1_Click() 'VuImage en vignette Dim fd As Office.FileDialog Dim varFichier As Variant Dim strListe As String Dim Name As String Dim strSourceFile As String Dim strTargetFile As String Dim fso As Scripting.FileSystemObject Dim Copy As String Dim Move As String Dim Img As WIA.ImageFile Dim IP As WIA.ImageProcess Dim strCheminComplet As String Dim strChemin As String 'SELECTIONNEZ UNE IMAGE '================= 'Créer une Boite de Dialogue Set fd = Application.FileDialog(msoFileDialogOpen) 'Titre de la Boite de Dialogue et Sélection Multiple fd.Title = "SELECTIONNEZ UNE IMAGE " fd.AllowMultiSelect = False fd.InitialView = msoFileDialogViewThumbnail 'Filtrer les Fichiers Images fd.Filters.Clear fd.Filters.Add "Tous les Fichiers", "*.*" fd.Filters.Add "Images", "*.jpg;*.jpeg" fd.FilterIndex = 2 'Pas de Nom par Défaut fd.InitialFileName = "C:\Users\Chris\Desktop\BOUQUIN\01Apn\" 'Afficher la Boite de Dialogue If fd.Show() Then 'Lister les Chemins des Fichiers Sélectionnés strListe = "" For Each varFichier In fd.SelectedItems strListe = strListe & varFichier & vbCrLf Next 'Afficher le Résultat MsgBox "VOUS AVEZ SELECTIONNE L'IMAGE SUIVANTE :" & vbCrLf & strListe, vbInformation End If 'RENOMMER LES FICHIERS AU NOM DU FILTRE REFERENCE '===================================== For Each varFichier In fd.SelectedItems varFichier = True Next Name FileName(fd.SelectedItems(1)) As (Me.RefImg53 & "_" & 1 & "." & "jpg") Me.NomImg1 = Me.RefImg53 & "_" & 1 & "." & "jpg" Me.Dossier1 = Me.Dossier1 & Me.NomImg1 Me.Export1 = Me.Export1 & Me.NomImg1 Me.Vignet1 = Me.Vignet1 & Me.NomImg1 'Sauvegarder le Nom de l'image DoCmd.RunCommand acCmdSaveRecord 'COPIER ET DUPLIQUER L'IMAGE DANS LES NOUVEAUX REPERTOIRES (PhotoHD, PhotoEX) '======================================================== 'Créer une Boite de Dialogue. Set fd = Application.FileDialog(msoFileDialogOpen) 'Titre de la Boite de Dialogue et Sélection Multiple. fd.Title = "RESELECTIONNEZ L'IMAGE RENOMMEE A VOTRE REFERENCE..." fd.AllowMultiSelect = False fd.InitialView = msoFileDialogViewThumbnail 'Filtrer les Fichiers Images. fd.Filters.Clear fd.Filters.Add "Tous les Fichiers", "*.*" fd.Filters.Add "Images", "*.jpg" fd.FilterIndex = 2 'Pas de Nom par Défaut. fd.InitialFileName = Me.RefImg53 & "_1.jpg" 'Afficher la Boite de Dialogue. If fd.Show() Then 'Lister les Chemins des Fichiers Sélectionnés. strListe = "" For Each varFichier In fd.SelectedItems strListe = strListe & varFichier & vbCrLf Next 'Afficher le Résultat. MsgBox "SELECTION IMAGE CORRESPONDANTE A VOTRE REFERENCE DE LIVRE...:" & vbCrLf & strListe, vbInformation End If 'Déplacer la Sélection dans C:\Livres\PhotoHD pour conservation et retraitement. strListe = "" For Each varFichier In fd.SelectedItems strListe = strListe & varFichier & vbCrLf Next 'Déplacel'image de 01APN dans le Dossier PhotoHD. Set fso = New Scripting.FileSystemObject strSourceFile = Me.RefImg53 & "_1.jpg" strTargetFile = "C:\Users\Chris\Desktop\BOUQUIN\03Imghd\" fso.MoveFile strSourceFile, strTargetFile Set fso = Nothing 'CREER UNE COPIE DE PHOTOHD POUR ENREGISTRER SOUS PHOTOEX POUR 300 KO MAXI. '========================================================================== 'Création conteneur pour l'image à manipuler Set Img = CreateObject("WIA.ImageFile") 'Création du gestionnaire de filtre Set IP = CreateObject("WIA.ImageProcess") 'Chargement de l'image dans le conteneur strCheminComplet = Me![Dossier1] Img.Loadfile (strCheminComplet) 'Ajoute le filtre pour redimensionner l'image (Scale/Echelle) IP.Filters.Add IP.FilterInfos("Scale").FilterID 'Définit la largeur maxi pour le redimensionnement IP.Filters(1).Properties("MaximumWidth") = 800 'Définit la hauteur maxi pour le redimensionnement IP.Filters(1).Properties("MaximumHeight") = 800 'Application du filtre à l'image Set Img = IP.Apply(Img) 'Ajoute le filtre pour modifier la résolution de l'image IP.Filters.Add IP.FilterInfos("Convert").FilterID 'Convertit au format JPEG IP.Filters(2).Properties("FormatID").Value = wiaFormatJPEG 'Définit la résolution de l'image IP.Filters(2).Properties("Quality").Value = 70 'Application du filtre à l'image Set Img = IP.Apply(Img) 'Enregistre l'image redimensionnée strCheminComplet = Me![Export1] Img.SaveFile (strCheminComplet) 'CREER UNE COPIE DE LA PHOTO HD POUR EN FAIRE UNE VIGNETTE A AFFICHER DANS LE FORMULAIRE '================================================================= 'Création conteneur pour l'image à manipuler Set Img = CreateObject("WIA.ImageFile") 'Création du gestionnaire de filtre Set IP = CreateObject("WIA.ImageProcess") 'Chargement de l'image dans le conteneur strCheminComplet = Me.Dossier1 Img.Loadfile (strCheminComplet) 'Ajoute le filtre pour redimensionner l'image (Scale) IP.Filters.Add IP.FilterInfos("Scale").FilterID 'Définit la largeur maxi pour le redimensionnement IP.Filters(1).Properties("MaximumWidth") = 96 'Définit la hauteur maxi pour le redimensionnement IP.Filters(1).Properties("MaximumHeight") = 96 'Application du filtre à l'image Set Img = IP.Apply(Img) 'Ajoute le filtre pour modifier la résolution de l'image IP.Filters.Add IP.FilterInfos("Convert").FilterID 'Convertit au format JPEG IP.Filters(2).Properties("FormatID").Value = wiaFormatJPEG 'Définit la résolution de l'image IP.Filters(2).Properties("Quality").Value = 70 'Application du filtre à l'image Set Img = IP.Apply(Img) 'Enregistre l'image redimensionnée strCheminComplet = Me.Vignet1 Img.SaveFile (strCheminComplet) 'Affichage de l'image Me.Img1.Picture = strChemin End Sub
J'aurais aimé savoir si j'avais une possibilité d'incrémenter les photos au pas de 1 sur la même référence (LPRC1_1.jpg; LPRC1_2.jpg; LPRC_3.jpg et coetera) ce qui me permettrais d'éviter 32 colonnes.
Le formulaire Photo est basé directement sur la table 53Image (LPRC1), filtré sur la RefImage53 (index sans D). Table qui elle même, est en relation 1-1 avec la table de création générique du livre (LPRC1).
Je précise que je ne suis un absolu débutant en VB et que mes neurones ont tendances à disparaître...
Merci pour vos réponses. Christophe
Partager