XL 2016 Image Useform

[Maathis]

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:

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:

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:

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 :

 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

 

[fanch55]

Bonsoir,
StrFilename est-il déclaré en Public ?

 

[Maathis]

Bonjour,
Je ne pense pas, enfin je ne sais pas comment je peux déclarer cette variable en public.
Merci

 

[fanch55]

Bonjour,
Regardez en haut des modules, si vous trouvez une déclaration de strfilename .

Sinon, si vous pouvez joindre une version de votre classeur expurgée des données confidentielles,
Nous pourrions vous dire exactement ce qui manque.

 

[Maathis]

Bonjour,
Regardez en haut des modules, si vous trouvez une déclaration de strfilename .
Regarde la pièce jointe 1086977

Sinon, si vous pouvez joindre une version de votre classeur expurgée des données confidentielles,
Nous pourrions vous dire exactement ce qui manque.

Merci j'ai essayé mais le problème est toujours le même, la photo ne veux pas passer de l'userform à ma cellule excel.
Malheureusement, mon fichier contient beaucoup de données confidentielles et le refaire sans données confidentielles me prendrait du temps.

Mais je pense que le problème vient du code pour insérer l'image depuis l'userform dans la cellule.
Le code pour mettre l'image dans l'userform est celui-ci :

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

et pour mettre cette image dans la cellule voulu est celui-ci:

ActiveCell.Offset(0, 5).Select
                
                 With Selection.Parents.Picture.Insert(strFileName)
                                                
                         .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 pense que la ligne de code :

 With Selection.Parents.Picture.Insert(strFileName)

contient une erreur elle ne permet pas d'accéder à l'image que j'ai envoyé vers le dossier du réseau.

Merci d'avance

 

[fanch55]

Il faudrait mettre un point d'arrêt à la ligne incriminée et mettre strfilename dans le cadre espion pour vérifier ce qu'elle contient .

 

[Maathis]

Je viens de changer ma variable je m'étais trompé, ensuite j'ai rajouté un espion et un point d'arrêt et ma variable correspond bien à l'emplacement de ma photo qu'Excel doit insérer.
Watch : : pic : "C:\Users\photo.jpg" : Variant/String : Saisie.save_Click

Je ne comprend pas d'où peux venir le problème

 

[fanch55]

J'ai pas bien compris cela ( et mon Vbe non plus ) :

                         Do While Selection.Width < boxphoto.Width
                             Selection.Columns.ColumnWidth = _
                             Selection.Columns.ColumnWidth 1
                         Loop

 

[fanch55]

Bon, ne cherchez pas plus, c'est une syntaxe qui n'est pas correcte :

With Selection.Parents.Picture.Insert(strFileName)
With Selection.Parent.Pictures.Insert(StrFileName)



Mais vérifiez le post précédent, je pense qu'il manque un +

 

[Maathis]

Bonjour, Effectivement j'avais bien fait cette erreur mais après l'avoir corrigé le problème reste le même je ne comprend pas pourquoi.
Je pense que le problème vient du fait que je renomme la variable "StrFileName" pour changé l'image de dossier et la renommé.

pic = strFileName
nom = Me.txtL
Name pic As "C:\Users\" & nom & ".jpg"

Je la renomme suivant une textbox dans mon userform, et à ce niveau pas de soucis l'image se renomme et se copie dans le fichier sans soucis. Mais cela ne pose t-il pas problème pour la suite avec la propriété Insert ?

Merci d'avance pour votre aide.

 

[Maathis]

J'ai pas bien compris cela ( et mon Vbe non plus ) :

                         Do While Selection.Width < boxphoto.Width
                             Selection.Columns.ColumnWidth = _
                             Selection.Columns.ColumnWidth 1
                         Loop

Ce code me permet d'adapter la taille de la cellule à la taille de l'image dans l'userform. C'est étrange car dans mon programme je n'ai pas de soucis.

 

[fanch55]

Bonjour,
Ne passez plus par un fichier intermédiaire,
surtout s'il est sauvegardé sur votre disque dur personnel .
Remplacez le code d'enregistrement par celui-ci ( j'ai collé au maximum au votre ):

    On Error Resume Next
       ' On détruit la photo si la cellule en contient une du même nom
        ActiveSheet.Shapes("Photo_" & Selection.Address).Delete
    On Error GoTo 0
    
    With ActiveSheet.Shapes.AddPicture( _
        strFileName, msoFalse, msoTrue, _
        Selection.Left, Selection.Top, _
        boxphoto.Width, boxphoto.Height)
        
        .Name = "Photo_" & Selection.Address
        .ControlFormat.PrintObject = msoFalse
        .LockAspectRatio = msoFalse
        Selection.RowHeight = .Height
        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
        .Placement = xlMoveAndSize
    End With

L'inconvénient :
Les images sont sauvegardés avec le classeur --> augmentation du poids de celui-ci ,
si cela ne vous convient pas il faut conserver l'insert mais sauvegarder vos images temporaires sur un disque réseau commun à vos utilisateurs ...

 

[fanch55]

Ce code me permet d'adapter la taille de la cellule à la taille de l'image dans l'userform. C'est étrange car dans mon programme je n'ai pas de soucis.

Quand vous allez dans le Vbe, les lignes ne sont pas en rouge ?
S'il n'y a pas d'erreur à l'exécution, c'est qu'il doit y avoir un On error qq part avant ...

Do While Selection.Width < boxphoto.Width

Selection.Columns.ColumnWidth = _​

Selection.Columns.ColumnWidth 1​

Loop

 

[patricktoulon]

bonjour
heu pour mettre une image au centre d'un range boucler "" jusqu'a tant que"" c'est un peu négligé comme code
et tes images si tu les garde en sauvant ton fichier deviendra trop lourd
si tu les garde pas et que tu travaille sur un autre pc (a moins qu'elle soient en reseau) ben tu n'a plus tes images

centrer une image dans un range en toute circonstances quel que soit le ratio (range/image)

bonjour a tous voici deux méthode avec exemple pour centrer une image sur un range la méthode que j'appelle directe en effet j'agit directement sur l'image en bloquant l'apect ratio...

www.excel-downloads.com

copier une image de l'userform vers la feuille
savepicture image1.picture,chemintemp
With Selection.Parent.Pictures.Insert(chemintemp)
'utiliser ma fonction de placement
end with
kill chemintemp

 

[Maathis]

Bonjour,
Ne passez plus par un fichier intermédiaire,
surtout s'il est sauvegardé sur votre disque dur personnel .
Remplacez le code d'enregistrement par celui-ci ( j'ai collé au maximum au votre ):

    On Error Resume Next
       ' On détruit la photo si la cellule en contient une du même nom
        ActiveSheet.Shapes("Photo_" & Selection.Address).Delete
    On Error GoTo 0
   
    With ActiveSheet.Shapes.AddPicture( _
        strFileName, msoFalse, msoTrue, _
        Selection.Left, Selection.Top, _
        boxphoto.Width - 5, boxphoto.Height - 5)
       
        .Name = "Photo_" & Selection.Address
        .ControlFormat.PrintObject = msoFalse
        .LockAspectRatio = msoFalse
        Selection.RowHeight = .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

L'inconvénient :
Les images sont sauvegardés avec le classeur --> augmentation du poids de celui-ci ,
si cela ne vous convient pas il faut conserver l'insert mais sauvegarder vos images temporaires sur un disque réseau commun à vos utilisateurs ...

Merci beaucoup mais justement est ce que c'st possible de sauvegarder des fichiers temporaires sur un dossier réseau pour que le fichier ne sois pas trop lourd et que tous les utilisateurs du réseau puissent voir les images ?