importation multiples photos

Version imprimable

06/03/2021, 10h22
C15nantes

importation multiples photos

Bonjour à tous et à toutes,

Actuellement je gère la base de données d'une association sous access

Ne trouvant personne pour prendre la relève, nous envisageons de passer sur une site de gestion en ligne.

Le transfert des données se fera via Excel (j'extraie une partie des données vers Excel et les importe ensuite vers le site).

Pour le moment, dans Access je peux afficher la photo de chaque adhérent via un lien qui va chercher la photo dans mon ordi

Je fais simple avec la procédure

Code:

Me.NomDeChemin = Me.Nom_Adherent & " " & Me.Prenom_Adherent & ".jpg"

le nom sous lequel est enrtegistrée la photo est le nom suivi du prénom de l'adhérent (Dupont Michel.jpg)

Les photos sont stockées dans le dossier ; elles font entre 5 et 50 ko chacune

Code:

="O:\Hervé\AHA\Photosbmp\Jpg"

Le tout marche parfaitement bien et permet surtout de ne pas stocker les photos dans la base afin de ne pas l'alourdir.

Pour le transfert des données entre Excel et le site, est-il possible d'afficher dans mon fichier Excel (qui comprendrait entre autre une colonne nom et une colonne prénom) une colonne où apparaitrait la photo de chaque adhérent ?

Je précise que contrairement à Access, ce n'est pas un lien que je veux mais la photo de chacun.

Par ailleurs, il faudrait que cela se fasse en une seule manip (j'ai 600 photos à afficher)

Merci de votre aide.

A+
C15
06/03/2021, 10h45
Patrice740

Bonjour,

Il est possible d'intégrer des photos sur une feuille Excel.

Mais as-tu essayé de transférer un fichier Excel avec des données et des photos correspondantes vers le site ?
Je doute fort que le site soit capable d'établir la relation entre les photos et les données via ce genre de transfert.
06/03/2021, 11h13
C15nantes

Bonjour,

J'ai fait des essais de transfert de données (nom prénom adresse...) vers le site via un fichier Excel.
Il y a quelques points à régler qui seront précisés cette semaine lors d'un rdv téléphonique

je n'ai pas fait d'essai avec des photos tant que je ne saurai comment intégrer automatiquement les 600 photos dans mon fichier Excel.

D'une part, il est hors de question de faire un lien dynamique entre le site et mon PC pour aller chercher les photos, d'autre part je ne me vois pas sur chacune des fiches adhérents insérer manuellement la photo de l'intéressé.

Merci de ton aide
C15

Bonjour,

En principe, sur un site, on regroupe toutes les photos dans un répertoire du serveur.
Sur une page html il faut et suffit d'un lien pour afficher l'image, par exemple
<img src="https://mon-site.fr/public/photos/membres/pierre_jacques.jpg"> .
D'autre part, il faut éviter d'utiliser des espaces dans le nom des fichiers, il est préférable d'utiliser pierre_jacques.jpg

C'est pour ça que je doute très fort que le site soit capable extraire les photos du fichier Excel et d'établir les liens ad hoc.

Mais si tu tiens à insérer dans images dans un fichier Excel, voici ce code à adapter :

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
56
57
58
59
60
Option Explicit
Sub incorporer_photos()
Dim feuille As Worksheet
Dim image As Picture
Dim cellule As Range
Dim dossier$, nom$, photo$
Dim dernièreLigne&, ligne&, marge%
Dim orientation#
  Call enlever_photos
  Set feuille = Worksheets("Feuil1")
  With feuille
    dossier = ThisWorkbook.Path & "\Photos\Membres\"
    dernièreLigne = .Columns("A").Find("*", , , , , xlPrevious).Row
    ' Dimensionner les cellules de destination
    .Columns("C").ColumnWidth = 22.14
    .Rows("2:" & dernièreLigne).RowHeight = 120
    marge = 5
    ' Placer les photos
    For ligne = 2 To dernièreLigne
      nom = .Cells(ligne, "B") & "_" & .Cells(ligne, "A")   'Prénom_Nom
      photo = dossier & nom & ".jpg"                        '...\Prénom_Nom.jpg
      If Dir(photo) <> "" Then
        Set cellule = .Cells(ligne, "C")                    'Destination
        Set image = ActiveSheet.Pictures.Insert(photo)
        With image.ShapeRange
          ' Position
          .Top = cellule.Top + marge
          .Left = cellule.Left + marge
          ' Adapter la taille selon l'orientation
          orientation = image.Width / image.Height
          If orientation < 1 Then
            ' Portrait
            .LockAspectRatio = msoTrue
            .Height = cellule.Height - 2 * marge
            If .Width > cellule.Width - 2 * marge Then .Width = cellule.Width - 2 * marge
            .Top = cellule.Top + (cellule.Height - .Height) / 2
            .Left = cellule.Left + (cellule.Width - .Width) / 2
          Else
            ' Paysage
            .LockAspectRatio = msoTrue
            .Width = cellule.Width - 2 * marge
            If .Height > cellule.Height - 2 * marge Then .Height = cellule.Height - 2 * marge
            .Top = cellule.Top + (cellule.Height - .Height) / 2
            .Left = cellule.Left + (cellule.Width - .Width) / 2
          End If
          .Name = nom
        End With
      End If
    Next
  End With
End Sub
Sub enlever_photos()
Dim forme As Shape
  For Each forme In Worksheets("Feuil1").Shapes
    If forme.Type = msoPicture Then
      forme.Delete
    End If
  Next forme
  Worksheets("Feuil1").UsedRange.Offset(1).Rows.AutoFit
End Sub

06/03/2021, 17h19
C15nantes

Bonjour,
Merci de cette réponse.

1 Je suppose que tout ce qui est en rouge doit être adapté à mon fichier

2 cette procédure, je la mets où et je la déclenche comment ?

A+
c15

Citation:

Envoyé par C15nantes

1 Je suppose que tout ce qui est en rouge doit être adapté à mon fichier
2 cette procédure, je la mets où et je la déclenche comment ?

2) Il faut mettre la macro (les 2 procédures) dans un module standard. Déclenchement au choix, soit directement depuis le VBE, soit à partir d'un bouton ou d'une forme sur la feuille.

1) Dans l'exemple précédent :
- le répertoire des photos est défini relativement au classeur qui contient la macro et dans lequel on importe les photos
- les noms des photos sont au format Prénom_Nom.jpg
- la feuille Feuil1 contient, à partir de la ligne 2, les noms dans la colonne A , les prénoms dans la colonne B et reçoit les photos dans la colonne C

Note : en rouge, c'est la coloration syntaxique des chaines de caractères (automatique sur ce site).

Il faut donc adapter le dossier, inverser prénom et nom dans la recherche des photos.

Voici l'adaptation (à vérifier) qui devrais fonctionner chez toi :
Il faut remplir la Feuil 1 avec les noms en A et prénoms en B sans laisser de lignes vides.

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
56
57
58
59
Option Explicit
Sub Incorporer_Photos()
Dim image As Picture
Dim cellule As Range
Dim dossier$, nom$, photo$
Dim derniereLigne&, ligne&, marge%
Dim orientation#
  Call Enlever_Photos
  dossier = "O:\Hervé\AHA\Photosbmp\Jpg\"
  With Worksheets("Feuil1")
    derniereLigne = .Columns("A").Find("*", , , , , xlPrevious).Row
    ' Dimensionner les cellules de destination
    .Columns("C").ColumnWidth = 22.14
    .Rows("2:" & derniereLigne).RowHeight = 120
    marge = 5
    ' Placer les photos
    For ligne = 2 To derniereLigne
      nom = .Cells(ligne, "A") & " " & .Cells(ligne, "B")   'Nom Prénom
      photo = dossier & nom & ".jpg"                        '...\Nom Prénom.jpg
      If Dir(photo) <> "" Then
        Set cellule = .Cells(ligne, "C")                    'Destination
        Set image = ActiveSheet.Pictures.Insert(photo)
        With image.ShapeRange
          ' Position
          .Top = cellule.Top + marge
          .Left = cellule.Left + marge
          ' Adapter la taille selon l'orientation
          orientation = image.Width / image.Height
          If orientation < 1 Then
            ' Portrait
            .LockAspectRatio = msoTrue
            .Height = cellule.Height - 2 * marge
            If .Width > cellule.Width - 2 * marge Then .Width = cellule.Width - 2 * marge
            .Top = cellule.Top + (cellule.Height - .Height) / 2
            .Left = cellule.Left + (cellule.Width - .Width) / 2
          Else
            ' Paysage
            .LockAspectRatio = msoTrue
            .Width = cellule.Width - 2 * marge
            If .Height > cellule.Height - 2 * marge Then .Height = cellule.Height - 2 * marge
            .Top = cellule.Top + (cellule.Height - .Height) / 2
            .Left = cellule.Left + (cellule.Width - .Width) / 2
          End If
          .Name = nom
        End With
      End If
    Next
  End With
End Sub
 
Sub Enlever_Photos()
Dim forme As Shape
  For Each forme In Worksheets("Feuil1").Shapes
    If forme.Type = msoPicture Then
      forme.Delete
    End If
  Next forme
  Worksheets("Feuil1").UsedRange.Offset(1).Rows.AutoFit
End Sub

06/03/2021, 18h33
C15nantes

Bonsoir

Merci de ces infos supplémentaires.

Je vais tester cela ce week-end et reviendrai vers toi...pour dire que cela marche :)

A+
C15