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)

57test-image.xlsm (24.92 Ko)

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

Bonjour

Voici un fichier avec un ComboBox !

Re,

Ca c'est le top !

Crois-tu que je peux encore te faire cogiter?

bien sure selon ton temps libre.

Un grand Merci

Amicalement

Noel


Re,

C'est simplement pour t'informer quand je l'enregistre sous format .XLS il me donne cette erreur dont je te prie de trouver le fichier joint.

@+

ice screenshot 20170407 094344

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

Rechercher des sujets similaires à "importer image saisie usf"