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 :

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