Importer Image en saisie en USF
Bonjour à tous,
Lors de la saisie en USF je voudrai importer une image dans le champ image.
Quelqu'un aurait-il la solution pour ne pas aller installer physiquement une image dans un répertoire.
Il y a un e 2ème demande concernant les images. Comme vous savez, dans un projet si on veut récupérer une image qui se trouve dans un répertoire il faut obligatoirement adresser un chemin. Mais quand on change d’ordinateur il faut absolument entrer dans le VBA pour le faire. Si quelqu'un avait la solution pour éviter d'entre dans le VBA je suis preneur.
Merci d'avance de vos propositions ou de votre aide
Amicalement
Noel
Bonjour,
Pas compris le problème... ?
Tu importes des images lors de la saisie, je crois comprendre donc que tu les charges dans le Userform et les décharges...
Elles sont dans un répertoire.
Le problème serait qu'en changeant d'ordi elles ne serait plus dans le même répertoire ?
Si c'est ça, une solution simple consiste sur les 2 ordinateurs à les mettre dans un sous-répertoire du répertoire où se trouve le classeur. Et évidemment même nom de ce sous-répertoire.
Mettons DossImg pour l'exemple : à partir de là tu as un chemin unique pour atteindre les images :
ThisWorkbook.Path & "\DossImg\" & "NomFichierImg.jpg"
Cordialement.
Bonjour,
Pour la première, je n'ai pas bien saisi (en attende de plus de précisions).
Pour ta seconde demande (changement de PC), tu peux effectuer une recherche sur disques mais ça peu prendre du temps donc, il serait bien d'en informer ton utilisateur et une fois trouvé, tu peux stocker le chemin dans un Nom invisible pour ne pas avoir à faire une recherche à chaque fois :
Declare Function SearchTreeForFile _
Lib "IMAGEHLP.DLL" ( _
ByVal lpRootPath As String, _
ByVal lpInputName As String, _
ByVal lpOutputName As String) As Long
Public Const MAXI = 255
Sub test()
'adapter le nom de l'image
MsgBox TrouveFichier("Mon Image.jpg")
End Sub
Function TrouveFichier(ByVal Nom As String)
Dim Fso As Object
Dim Lecteurs As Object
Dim Lect As Object
Dim Dossier As String
Dim Fichier As String
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Lecteurs = Fso.drives
TrouveFichier = "Fichier introuvable !"
'récupère les lecteurs locaux (type 2) et les passe en revue
For Each Lect In Lecteurs
If Lect.DriveType = 2 Then
Dossier = Lect.driveletter & ":\"
Fichier = ChercheFichier(Dossier, Nom)
If Fichier <> "" Then
TrouveFichier = Fichier
Exit For
End If
End If
Next Lect
End Function
Public Function ChercheFichier(Chemin As String, Fichier As String) As String
Dim Pos As Long
Dim Resultat As Long
Dim Tampon As String
On Error GoTo Fin
If Chemin = "" Then Chemin = Left(CurDir, 3)
'défini la taille du tampon
Tampon = Space(MAXI * 2)
'effectue la recherche
Resultat = SearchTreeForFile(Chemin, Fichier, Tampon)
If Resultat Then
Pos = InStr(Tampon, vbNullChar)
If Not Pos Then Tampon = Left(Tampon, Pos - 1)
ChercheFichier = Tampon
Else
ChercheFichier = ""
End If
Exit Function
Fin:
ChercheFichier = ""
End Function
Bonjour à vous deux,
Certes moi même j'arrive très ma l à me faire comprendre.
Dans un 1er temps j'ai crée un USF avec un champ image éventuellement pour retrouver a un fichier de photos par exemple d'adhérents. Lors de la saisie je souhaite pouvoir en création de l'adhérent d'inclure la photo de l'adhérent sans pour autant aller l'installer dans un répertoire.
Dans un second temps c'est de pouvoir rappeler l'image de l'adhérent quand j'appelle cet adhérent. Celui là je sais comment fair car j'utilise ce code :
ImageAdh.Picture = LoadPicture("C:\Users\CHANE FO\Desktop\APIE\A-Adh - Copie\" & MyImage & ".jpg").
Mais quand un utilisateur s'en sert sur un autre ordi, actuellement je suis dans l'obligation d'ouvrir le VBA pour pouvoir changer le chemin.
Donc je cherche une solution pour ne plus avoir à ouvrir le VBA mais je pouvais le faire par code se serait mieux.
J'espère être assez explicite.
Merci beaucoup de votre aide.
La proposition de Theze je l'essaierai, mais je crois le mieux c'est de me faire un fichier pour savoir comment ça marche et surtout la démarche. Merci Theze
Amicalement
Noel
Re,
Lors de la saisie je souhaite pouvoir en création de l'adhérent d'inclure la photo de l'adhérent sans pour autant aller l'installer dans un répertoire.
Là, je dirai que tu n'as pas le choix, il faut bien qu'il soit sur un disque et dans un dossier sinon, la méthode LoadPicture() ne saura pas où le prendre !
Je viens de faire un fichier avec Formulaire. Tu entres le nom de ton fichier image avec l'extension dans le TextBox (sans le chemin bien sûr !) puis tu cliques sur le bouton. Attention, la recherche peut être assez longue si plusieurs disques locaux ! Une fois l'image chargée dans le contrôle Image, tu peux fermer le formulaire et ensuite le ré-ouvrir, tu entre à nouveau le nom de ton fichier image et tu cliques sur le bouton, le chargement de l'image sera plus rapide car le chemin du dossier est stocké dans le nom "Dossier" (invisible dans le gestionnaire de noms)
Bonjour Theze,
C'est certainement bon mais j'attends. Comme tu disais que cela risque d'être long, là je ne sais pas s'il cherche toujours.
Aurais-tu une solution pour visualiser sa recherche par une barre de progression par exemple.
Merci de ton dévouement.
Amicalement
Noel
Re,
Entre le moment que je t'ai répondu et au moment que je t'informe rien ne se passe.
Puis-je déterminé que le temps n'est pas assez long ou trop. C'est pour cela que pendant ce temps je ne sais pas s'il faut je termine et je ferme pas la petite croix.C'est pour cela que je te propose soit par une Barre de progression, soit que le croix de femetur n'est pas accessible.
Sinon tu as bien compris ce que je voulais.
Merci de ton expérience.
Amicalement
Noel
Re,
Autant pour moi.Je ne lis jamais le message jusqu'au bout. En lisant les codes, j'ai compris qu'il fallait creér un répertoire portant le nom "Dossie". Ca fonctionne c'est formidable. Maintenant je faire en sorte que le champ image s'adapte en conséquence à la grandeur de l'image avec "autosize" bien entendu j'essaierai de mettre toutes les images au même format qui soit dans le dans le sens paysage ou portrait.
Merci.
La Réunion est une Ile extraordinaire quand tu seras décidé de venir la visiter fais moi signe.
@+
Amicalement
Noel
Re,
Rassure moi le Bouton "Supprimer le nom" c'est pour supprimer le nom du "Dossier" et peut-on le remplacer par un autre nom sans pour autant entrer dans le VBA ni dans la macro.
Merci de me tenir informé pour la suite
Noel
Bonjour,
Normalement, tu n'as pas à créer de dossier, le nom "Dossier" est le nom donné à l'objet Name (onglet "Formule" zone "Noms définis" puis "gestionnaire de noms", ce nom est invisible (valeur False)). Quand tu change de PC, tu dis ne pas connaître le dossier où sont stockées les images donc, si l'image recherchée est trouvée sur un des disques locaux, c'est le chemin du dossier où se trouve cette image qui est stocké dans le nom qui s'appelle "Dossier" afin d'avoir un accès plus rapide aux images par la suite (les différentes images étant sensées être toutes dans ce même dossier). Sinon, il y a bien plus simple et surtout plus rapide, c'est de demander à l'utilisateur d'indiquer où se trouve le dossier et ensuite, il suffit de mémoriser le chemin dans le nom. Un exemple, le code ci-dessous est a mettre à la place de l'ancien :
Private Sub CommandButton1_Click()
Dim CheminImg As String
Dim Nom As Name
'passe par un petit contrôle. A améliorer !
If TextBox1.Text = "" Then Exit Sub
If UCase(Right(TextBox1.Text, 4)) <> ".JPG" And UCase(Right(TextBox1.Text, 4)) <> ".GIF" Then Exit Sub
If Len(TextBox1.Text) < 5 Then Exit Sub
On Error Resume Next
Set Nom = ThisWorkbook.Names("Dossier")
'récup de la valeur du nom puisqu'il existe
If Err.Number = 0 Then
'supprime les guillemets
CheminImg = Replace(Right(Nom, Len(Nom) - 1), """", "")
Else
'annule le gestionnaire
On Error GoTo 0
'ouvre la boite de dialogue pour choisir un dossier
With Application.FileDialog(4)
'si un choix est fait...
If .Show = -1 Then
CheminImg = .SelectedItems(1) & "\"
'mais que le fichier image ne se trouve dans ce dossier, message et fin
If Dir(CheminImg & TextBox1.Text) = "" Then
MsgBox "Le fichier '" & TextBox1.Text & "' ne se trouve pas dans le dossier '" & CheminImg & "' !" _
& vbCrLf & _
"Indiquez un autre dossier si vous le souhaitez !"
Exit Sub
'sinon, enregistrement dans le nom
Else
'le nom est créé avec comme valeur le chemin du dossier sans le nom du fichier
'tous les fichier imagesd sont sensés être dans ce dossier, si ce n'est pas le cas, adapter le code en fonction !
ThisWorkbook.Names.Add "Dossier", CheminImg, False
End If
'annulation du choix du dossier
Else
MsgBox "Annulé !"
Exit Sub
End If
End With
End If
'contrôle si le fichier image se trouve bien dans le dossier qui est enregistré dans le nom
If Dir(CheminImg & TextBox1.Text) <> "" Then
Image1.Picture = LoadPicture(CheminImg & TextBox1.Text)
Else
MsgBox "Le fichier '" & TextBox1.Text & "' ne se trouve pas dans le dossier '" & CheminImg & "' !"
End If
End Sub
Pour tester, supprime le nom du gestionnaire avec ceci :
Sub Supprimer()
Dim Nom As Name
On Error Resume Next
Set Nom = ThisWorkbook.Names("Dossier")
Nom.Delete
End Sub
Re
Supprimer, supprime le nom du dossier ou le dossier?
@+
Noel
La procédure crée un nom dans le classeur de la même manière que si tu sélectionnes une ou plusieurs cellules et que tu décides de donner un nom à cette plage pour que ça te soit plus parlant !
La procédure "Supprimer()" supprime juste le nom du classeur et rien d'autre, aucun dossier n'est supprimé sur le disque rassure-toi
Bonjour Theze
Merci de me rassurer. Je voudrai savoir, si je peux rajouter un ComBoBox dans l'USF qui récupère tous les noms des images du dossier et que je pourrai utiliser le "CheminImg" comme tu l'as déterminé pour ne pas avoir à changer d'adresse manuellement au niveau du VBA.
Merci encore de ton aide
Amicalement
Noel
Re,
MFerrand m'a fait un petit projet par sa taille mais grand par ce qui se fait. En un mot il m'a fait un combobox qui récupère tous les projets (classeurs) en .xls se trouvant dans un dossier.
Je pense qu'il est possible d'avoir la même chose avec les .JPG, Gif ou PDF. Mois je ne sais pas faire même si me réfère à ce qu'il a fait car je ne vois pas comment m'y prendre.
Peut être que lui même s'il suit ce fil pourra intervenir et m'aider à le conclure.
Merci d'avance.
Amicalement
Noel
Re
Regardes dans le menu "Outils" ---> "Références..." et décoche les case où il y a marqué "Manquant" pour voir !
Bonjour Theze,
Le 2ème classeur ne fonctionne pas sous 2003. Ça fonctionne bien sous 2010.
Je vais essayer ce que tu me demandes car il faut un certain temps pour trouver et me repérer sous 2010.
Merci
Amicalement
Noel
Re,
C'est bon. J'ai suivi à la lettre ce que tu m'as dit
Je voudrai rajouter les formats".ICO".
[code] If Dir(CheminImg & "*.jpg") = "" And Dir(CheminImg & "*.gif") = "" And Dir(CheminImg & "*.ico") = "" Then[/code]
J'ai essayé de rajouter dans le code cela ne fonctionne pas ou j'ai du zapper quelque chose.
Pourras-tu voir cela
Merci d'avance
Amicalement
Noel