XL 2016 Image Useform

Maathis

Maathis

XLDnaute Nouveau
Bonjour à tous,

Alors j'ai un petit problème avec un userform de saisie de données.
Le but de mon userform est de rentrer des infos sur un produit avec son image et ensuite de ranger ses valeurs dans un tableau.
Le problème c'est que ce document va être utilisé par plusieurs personnes différents sur leurs ordinateurs donc si elle insère une photo depuis leur photos par exemple, il faut que les autres utilisateurs puissent voire l'image ensuite.
J'avais réussi à obtenir ce que je voulais mais depuis le userform (grâce à votre aide sur ce forum), l'image était insérée en fichier temporaire et donc sur un autre poste, il y avait ce message:
Capture.PNG


J'ai donc eu l'idée de:
Au moment ou on va enregistrer les informations dans la base de données, l'image soit copié, renommé et envoyé vers un dossier accessible par toute les personnes du réseau et ensuite Excel prend ce fichier la pour l'insérer dans la base de données, ainsi tout le monde peut y avoir accès.
Mais est-ce la meilleure des solutions dans mon cas ?

Actuellement avec cette solution je bloque au moment ou Excel doit prendre l'image dupliquée dans le dossier accessible par tous le monde et l'insérer dans la bonne case du tableau.
Tous d'abord je vous met mon code pour insérer une image dans le useform:
VB: 
Private Sub import_photo_Click()

 On Error GoTo Pasimage
    strFileName = Application.GetOpenFilename(filefilter:="JPEG Files (*.jpg;*.jpeg;*.jfif;*.jpe),*.jpg;*.jpeg;*.jfif;*.jpe,Bitmap Files(*.bmp),*.bmp", MultiSelect:=False)

    Me.boxphoto.Picture = LoadPicture(strFileName)
    Me.boxphoto.PictureSizeMode = fmPictureSizeModeStretch
    
    Me.Repaint
        
    End If

Exit Sub
Pasimage: MsgBox "Aucune image"

End Sub

Puis Quand je clique sur le bouton enregistré voici ce qu'il se passe:

Code: 
pic = strFileName
        nom = Me.txtL
        
        Name pic As "C:\Users\" & nom & ".jpg"
        
                Sheets("Base").Unprotect ""
                
                
                Me.ID = "" & ID
                
                Sheets("Base").Activate
                Range("B100000").End(xlUp).Offset(1, 0).Select
                ActiveCell = Me.ID
                ActiveCell.Offset(0, 1) = Me.txtL
                ActiveCell.Offset(0, 2) = Me.txtC
                ActiveCell.Offset(0, 3) = Me.cbA
                ActiveCell.Offset(0, 4) = Me.cbM
            
    
                
                SavePicture boxphoto.Picture, pic
                
                ActiveCell.Offset(0, 5).Select
                
                 With Selection.Parents.Picture.Insert(pic)
                
                
                         .Placement = xlFreeFloating
                        
                        .PrintObject = msoFalse
                        .ShapeRange.LockAspectRatio = msoFalse
                        .Height = boxphoto.Height - 5
                        .Width = boxphoto.Width - 5
              
                        Selection.RowHeight = boxphoto.Height
                        If Selection.Width > boxphoto.Width _
                        Then Selection.Columns.ColumnWidth = 1
                      
                         Do While Selection.Width < boxphoto.Width
                             Selection.Columns.ColumnWidth = _
                             Selection.Columns.ColumnWidth + 1
                         Loop
                    .Placement = xlMoveAndSize
                End With
                
                Sheets("Base").Protect ""
                ActiveSheet.EnableAutoFilter = True
                
                Unload Me
                Sheets("Accueil").Activate
                MsgBox "Ajouté dans la base de données"
    End If

Une erreur se produit à cette ligne :
Code: 
 With Selection.Parents.Picture.Insert(strFileName)
Le message d'erreur est que la proprieté insert n'est non géré.

Merci d'avance pour vos solutions.
Mathis
 
Trier par date Trier par votes
fanch55

fanch55

XLDnaute Barbatruc
Maathis à dit:
Exactement, il y a en effet un espace commun dont je peux me servir et oui peut importe d'où il prélèvent la photo, elle sera dupliqué vers l'espace commun et inséré sous forme d'image ou de lien hypertexte.
Cliquez pour agrandir...
Un lien hypertexte est moins lourd qu'une image certes, donc un classeur moins volumineux.
Cependant il utilise le moteur internet en tache de fond:
Quand on clique sur le lien, il se connecte au serveur ( ou disque réseau ) et lance l'application dédié aux images, donc plus on clique et plus on ouvre de fenêtres qu'il faut fermer ...
C'est un effet collatéral ...
Mais il existe un palliatif pour l'hyperlien :
www.excel-downloads.com

Microsoft 365 - Affichage d'une image au survol d'un Lien hypertexte Excel

Bonjour J'aimerais savoir si on peut afficher l'image correspondant au lien hypertexte au lieu de l'adresse. J'ai un fichier de plus de 4000 lignes et il est très long de cliquer sur le lien pour voir l'image D'avance merci de votre aide...
www.excel-downloads.com www.excel-downloads.com

Si tu veux que je t'aide, dis-moi quelle est la solution que tu retiens .
 
Vote positif 0 Vote négatif
Maathis

Maathis

XLDnaute Nouveau
fanch55 à dit:
Un lien hypertexte est moins lourd qu'une image certes, donc un classeur moins volumineux.
Cependant il utilise le moteur internet en tache de fond:
Quand on clique sur le lien, il se connecte au serveur ( ou disque réseau ) et lance l'application dédié aux images, donc plus on clique et plus on ouvre de fenêtres qu'il faut fermer ...
C'est un effet collatéral ...
Mais il existe un palliatif pour l'hyperlien :
www.excel-downloads.com

Microsoft 365 - Affichage d'une image au survol d'un Lien hypertexte Excel

Bonjour J'aimerais savoir si on peut afficher l'image correspondant au lien hypertexte au lieu de l'adresse. J'ai un fichier de plus de 4000 lignes et il est très long de cliquer sur le lien pour voir l'image D'avance merci de votre aide...
www.excel-downloads.com www.excel-downloads.com

Si tu veux que je t'aide, dis-moi quelle est la solution que tu retiens .
Cliquez pour agrandir...
Je pense que la solution du lien reste quand même la solution la plus adapté car dans ma base la photo est secondaire donc quand on lis la ligne correspondante, on a déjà pas mal d'informations.
La meilleure des solutions serait de dupliquer l'image dans un dossier réseau (en gardant la qualité d'image d'origine si possible) et ensuite d'avoir le lien hypertexte. Mais bien sur si l'affichage de l'image au survol du lien est possible en plus, je suis preneur.

Merci pour ton aide
 
Vote positif 0 Vote négatif
fanch55

fanch55

XLDnaute Barbatruc
A tester .
On a donné le nom "Photo" à la cellule A1 .
Pour les tests :
Il faut sélectionner une cellule (vide de préférence) et cliquer sur
1607012275875.png


Le code de l'userform doit être modifié pour indiquer le chemin du disque réseau :
1607012495358.png


Par la suite, on peut préciser quelle cellule doit recevoir l'hyperlien :

1607012704681.png

Du code a été mis dans la feuille, il faudra le recopier dans la feuille finale pour que les liens fonctionnent comme prévu .

🤗 😎
 

Pièces jointes

  • Maathis-Hyperliens.xlsm
    29.2 KB · Affichages: 13
Vote positif 0 Vote négatif
Maathis

Maathis

XLDnaute Nouveau
Alors j'ai pu copier-coller le code avec certaines modifications et ça fonctionne bien 🤗🤗🤗
, mais il y a plusieurs truc que je n'arrive à modifier et pourtant ça me parait simple.

Tout d'abord la cellule qui reçoit le Me.txtL prend le nom de l'image et j'aurais aimé que ce soit l'inverse mais je ne trouve pas le code correspondant 🧐

Et avec l'image renommé, je suppose que si une image existe déjà dans ce dossier avec le même nom, Excel va donc détecter un doublon ? Dans ce cas je pourrais mettre une gestion d'erreur pour éviter les doublons.

Mais merci beaucoup pour votre aide :)
 
Vote positif 0 Vote négatif
Maathis

Maathis

XLDnaute Nouveau
Victoire j'ai réussi le programme fait exactement ce que je voulais je poste ce que j'ai fait ( avec votre aide) :
Déclaration des variables:
VB: 
Option Explicit
Dim strFileName As Variant
Const CheminReso = "C:\Users\" ' Dossier Image commun du réseau

Pour insèrer la photo dans l'userform:
Code: 
        On Error GoTo Pasimage
        strFileName = Application.GetOpenFilename(filefilter:="JPEG Files (*.jpg;*.jpeg;*.jfif;*.jpe),*.jpg;*.jpeg;*.jfif;*.jpe,Bitmap Files(*.bmp),*.bmp", MultiSelect:=False)
    
        If strFileName <> False Then
            ' Visualiser l'image au bonne dimension
            Me.boxphoto.Picture = LoadPicture(strFileName)
            Me.boxphoto.PictureSizeMode = fmPictureSizeModeStretch
            Me.Repaint ' rafraichir l'userform
            
        End If

Exit Sub
Pasimage: MsgBox "Aucune image sélectionnée"

Pour enregistrer l'image dans le dossier commun et la renommer:
Code: 
Dim strFileReso As Variant
            strFileReso = CheminReso & Me.txtL & ".jpg"
            FileCopy strFileName, strFileReso

Pour insèrer cette image dans la cellule correspondante:
Code: 
ActiveCell.Offset(0, 5).Select
        
         With Selection.Parent.Pictures.Insert(strFileReso)
        
            .Placement = xlFreeFloating
            .PrintObject = msoFalse
            .ShapeRange.LockAspectRatio = msoFalse
            .Height = boxphoto.Height - 5
            .Width = boxphoto.Width - 5
              
            Selection.RowHeight = boxphoto.Height
            If Selection.Width > boxphoto.Width _
            Then Selection.Columns.ColumnWidth = 1
                      
            Do While Selection.Width < boxphoto.Width
                Selection.Columns.ColumnWidth = _
                Selection.Columns.ColumnWidth 1
            Loop
            .Placement = xlMoveAndSize
        End With

Je suis d'accord que le code n'est pas parfait il doit y avoir beaucoup d'améliorations possibles mais il fonctionne, merci pour votre aide encore une fois. 🤗
Mathis
 
Vote positif 0 Vote négatif
fanch55

fanch55

XLDnaute Barbatruc
Corrigez ce code qui me laisse perplexe :

If Selection.Width > boxphoto.Width + 5 _​
Then Selection.Columns.ColumnWidth = 1​
​
Do While Selection.Width < boxphoto.Width​
Selection.Columns.ColumnWidth = _​
Selection.Columns.ColumnWidth + 1​
Loop​

Sinon, le nom du fichier sauvegardé est défini par Me.txtL, valeur entrée par l'utilisateur,
Le FileCopy fait le boulot bestialement, que le fichier existe ou pas .
Donc, vous allez devoir vérifier que le nom n'existe pas quand me.txtL est saisi.

Je pense pour ma part que ce n'est pas très sioux de demander de saisir un nom, vous risquez d'écraser des images existantes dans des cellules précédentes .

Il faut également prévoir de détruire l'image de la cellule,
car l'insert ne fait qu'accumuler les images, exemple ci-dessous
il y a 3 images dans la même cellule
1607087991348.png

Analysez le code ci-joint qui garantit des noms de photo unique et une seule photo par cellule .
 

Pièces jointes

  • Maathis-Insert.xlsm
    28.5 KB · Affichages: 8
Vote positif 0 Vote négatif
Maathis

Maathis

XLDnaute Nouveau
J'ai créer une petite boucle qui permet de voir si le fichier existe déjà pour ne pas l'écraser :
VB: 
strFileReso = CheminReso & Me.txtL & ".jpg"

        Dim Nom_img As String
        
        Nom_img = Dir(strFileReso)
        
        Do Until Nom_img = ""
        
            nom = InputBox("Veuillez changer le nom (ou précisez):", "Déja présent")
            Me.txtL = nom
            strFileReso = CheminReso & Me.txtL & ".jpg"
            Nom_img = Dir(strFileReso)
            Do While Len(nom) = 0
                MsgBox "Le nom est obligatoire", vbExclamation, "Erreur Système"
                nom = InputBox("Veuillez changer le libellé du défaut (ou précisez):", "Défaut déja présent")
                Me.txtL = nom
                strFileReso = CheminReso & Me.txtL & ".jpg"
                Nom_img = Dir(strFileReso)
            Loop
            
        Loop
      
        FileCopy strFileName, strFileReso
        
        ActiveCell.Offset(0, 5).Select
        
         With Selection.Parent.Pictures.Insert(strFileReso)
        
            .Placement = xlFreeFloating
            .PrintObject = msoFalse
            .ShapeRange.LockAspectRatio = msoFalse
            .Height = boxphoto.Height - 5
            .Width = boxphoto.Width - 5
              
            Selection.RowHeight = boxphoto.Height
            If Selection.Width > boxphoto.Width _
            Then Selection.Columns.ColumnWidth = 1
                      
            Do While Selection.Width < boxphoto.Width
                Selection.Columns.ColumnWidth = Selection.Columns.ColumnWidth + 1
            Loop
            .Placement = xlMoveAndSize
        End With

Et dans mon cas je pense que c'est impossible qu'il y ait une image déjà présente dans la cellule. :oops:
 
Vote positif 0 Vote négatif
fanch55

fanch55

XLDnaute Barbatruc
Maathis à dit:
J'ai créer une petite boucle qui permet de voir si le fichier existe déjà pour ne pas l'écraser :
Et dans mon cas je pense que c'est impossible qu'il y ait une image déjà présente dans la cellule. :oops:
Cliquez pour agrandir...
1) l'utilisateur ne peut faire que des ajouts et pas de mise à jour. 🤗
2) l'utilisateur peut faire une mise à jour mais en changeant le nom de la photo :
pollution du disque réseau, plusieurs photos pour la même cellule ( à moins que la ligne complète soit recréée ... ) 🥳

Il va falloir étudier un nettoyage du dossier réseau ... 🤫

Le dernier fichier proposé imposait un nom modèle : Photo_[addresse de cellule] :
Pas de doublon possible .
 
Vote positif 0 Vote négatif
Maathis

Maathis

XLDnaute Nouveau
fanch55 à dit:
1) l'utilisateur ne peut faire que des ajouts et pas de mise à jour. 🤗
2) l'utilisateur peut faire une mise à jour mais en changeant le nom de la photo :
pollution du disque réseau, plusieurs photos pour la même cellule ( à moins que la ligne complète soit recréée ... ) 🥳

Il va falloir étudier un nettoyage du dossier réseau ... 🤫

Le dernier fichier proposé imposait un nom modèle : Photo_[addresse de cellule] :
Pas de doublon possible .
Cliquez pour agrandir...
L'utilisateur peux faire des mise a jours, mais il ne peux pas modifier ni le nom(associé à la photo), ni la photo, dans mon cas s'il veux modifier la photo c'est qu'il n'y a plus de rapport avec l'information donc autant supprimer la ligne et retaper une nouvelle information.

Au niveau des fichiers doublon et de la pollution du réseau, j'ai essayé de faire en sorte à ne jamais avoir plusieurs photos portant le même nom et j'ai rajouté une option qui supprime la photo dans le dossier réseau au moment où l'utilisateur supprime une information dans la base de données.

Et j'ai pensé à mettre une gestion d'erreur dans le cas ou l'utilisateur met un nom avec des caractères spéciaux, ce qui va poser problème au moment d'enregistrer l'image au format jpg.

Je pense qu'il y a encore des soucis à régler, je les verrais à l'utilisation du fichier.

Merci encore pour ton aide pour la création du fichier. 🎉
 
Vote positif 0 Vote négatif

Discussions similaires

jeff1494
  • Question
XL 2021 Orientation d'une image dans le commentaire d'une cellule
2 3
Réponses
42
Affichages
2 K
AtTheOne
AtTheOne
M
  • Résolu(e)
Microsoft 365 Image stockée dans une feuille à l'initialisation du userform
2
Réponses
20
Affichages
2 K
meyscal
M
Maathis
  • Résolu(e)
XL 2016 AIDE Useform Image
2
Réponses
24
Affichages
2 K
Maathis
Maathis
K
  • Question
Microsoft 365 choisir une page
Réponses
6
Affichages
771
xUpsilon
xUpsilon
E
  • Résolu(e)
Microsoft 365 enregistrer une image dans un dossier créé
Réponses
3
Affichages
2 K
eloiiid
E
Le_Troll_Du_27
  • Question
XL 2016 Logo dans une feuille et données dans une autre
Réponses
2
Affichages
1 K
Le_Troll_Du_27
Le_Troll_Du_27
D
  • Question
Enregistrer sous une image creer par macro sous Excel
Réponses
5
Affichages
11 K
devi16
D
nrdz83
  • Question
formulaire avec photo
Réponses
5
Affichages
18 K
nrdz83
nrdz83
P
  • Question
insérer et renommer avec une macro.
Réponses
11
Affichages
2 K
pa44pa28
P
Syntaxerror
  • Question
Récupérer les dimentions d'un fichier image
Réponses
13
Affichages
4 K
Syntaxerror
Syntaxerror

Membres actuellement en ligne

13 membres et 104 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 138
Messages
2 116 676
Membres
112 830
dernier inscrit
kuujuak