XL 2016 Copier une image contenu dans un UserForm dans la feuille active

Jgral · 2 Décembre 2019

Bonjour,

Je bosse sur un petit projet qui a pour but de faciliter la réalisation d'étude technique pour mon entreprise.

J'avoue être loin d'être un expert en VBA.

En gros l'idée c'est que lorsqu'on un agent clique sur un bouton une fenêtre apparaît. Dans la UserForm ouvert j'ai mis des Images numérotées de 1 à 15 sous lesquelles il y a des cases à cocher afin de les sélectionner. Jusque là tout va nickel. Mais ça ce corse.

Je n'arrive pas a faire afficher l'image sélectionnée :

VB:

Private Sub CommandButton1_Click() 'Bouton Valider
    If CheckBox1 = True Then
        ActiveSheet.Shapes.Add = UserForm1.Image1 ' Ligne que je n'arrive pas à coder permettant la copie de l'image à laquelle la case coché
    End If
Unload Me
End Sub

Private Sub CommandButton2_Click() 'Bouton Annuler
    Unload Me
End Sub

Voici le UserForm en question pour que vous compreniez bien (c'est pas évident à expliquer )

Merci par avance

patricktoulon · 3 Décembre 2019

re
bonjour a tous
je pige pas vraiment le soucis en fait

VB:

SavePicture Me.Image1.Picture, ThisWorkbook.Path & "\temp.jpg"
With ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\temp.jpg")
        .Name = Me.Image1.Name
        .Left = [B2].Left
        .Top = [B2].Top
        .Width = Me.Image1.Width
        '.Height = me.image1.width
    End With
Kill ThisWorkbook.Path & "\temp.jpg"

patricktoulon · 3 Décembre 2019

re
bonjour a tous
je pige pas vraiment le soucis en fait

VB:

SavePicture Me.Image1.Picture, ThisWorkbook.Path & "\temp.jpg"
With ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\temp.jpg")
        .Name = Me.Image1.Name
        .Left = [B2].Left
        .Top = [B2].Top
        .Width = Me.Image1.Width
        '.Height = me.image1.width
    End With
Kill ThisWorkbook.Path & "\temp.jpg"

Jgral · 3 Décembre 2019

patricktoulon à dit:

re
bonjour a tous
je pige pas vraiment le soucis en fait

VB:

SavePicture Me.Image1.Picture, ThisWorkbook.Path & "\temp.jpg"
With ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\temp.jpg")
        .Name = Me.Image1.Name
        .Left = [B2].Left
        .Top = [B2].Top
        .Width = Me.Image1.Width
        '.Height = me.image1.width
    End With
Kill ThisWorkbook.Path & "\temp.jpg"

Bonjour et merci de votre participation.

Si je comprends votre code cela consiste a copié l'image du UserForms dans un "presse papier" et le coller dans B2 ?

patricktoulon · 3 Décembre 2019

re
Bonjour
non cela consiste a sauver l'image au même endroit ou est enregistré le classeur
puis
inserer l'image dans le sheet
puis
supprimer l'image enregistrée
voila

par le clipbord c'est possible aussi mais c'est plus compliqué il faut utiliser les api et si le fichier est utilisé sur plusieurs pc différents avec différentes exploitations et ou paramètres ça risque d’être cotons

conclusion cette méthode est la plus simple

Jgral · 3 Décembre 2019

Vous êtes au top merci infiniment pour vos précisions.

Vous êtes très pédagogue !

job75 · 3 Décembre 2019

Bonjour patricktoulon,

Je ne connaissais pas SavePicture, merci.

Bonne journée.

herve62 · 3 Décembre 2019

Bonjour tous
@Jgral
J'arrive à la fin dans ce sujet mais comme j(ai fait 2 appli du style je voulais juste savoir si
tes images avait un nom unique (ex : cable1 , CBT22 ....etc) ensuite faut-il les recopier dans un onglet ?
je peux pas mettre le gros fichier mais je laisse 2 images de la dernière appli , j'ai encore une autre similaire plus légère , on verra après
Donc là dans l'usf le bouton permet d'ouvrir l'explorateur ( on peut figer le répertoire et le type de fichiers) , de cliquer sur l'image voulu , ensuite il y a un bouton valider et le résultat est un transfert de cette image dans un onglet à la suite des autres avec ajustement de la cellule
A toi de voir si c'est le style cherché ?

XL 2016 Copier une image contenu dans un UserForm dans la feuille active

Jgral

XLDnaute Nouveau

patricktoulon

patricktoulon

XLDnaute Barbatruc

Jgral

XLDnaute Nouveau

patricktoulon

XLDnaute Barbatruc

Jgral

XLDnaute Nouveau

job75

XLDnaute Barbatruc

herve62

XLDnaute Barbatruc

Pièces jointes

Discussions similaires