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

Jgral

XLDnaute Nouveau
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 :) )

lignedds.jpg


Merci par avance
 
Solution
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"

Dranreb

XLDnaute Barbatruc
Bonjour.
Le fond du problème dans ce que vous espériez pouvoir faire c'est qu'il n'existe pas de système de communication simple entre les objets de formulaire (les Shape) et les objets ActiveX (capables de supporter dans une feuille des contrôles MSForms). Donc il faut soit ruser par une programmation lourde et compliquée soit prévoir des supports compatibles, c'est à dire ActiveX. Un Me.Image1 est difficilement exploitable pour garnir un Shape, par contre un OLEObject.Object.Picture = Me.Image1.Picture ça, ça marche.
 

Jgral

XLDnaute Nouveau
Bonjour et merci de votre aide.

J'avais en effet essayer ceci mais ça ne marche pas.

VB:
Private Sub CommandButton1_Click() 'Bouton Valider
    If CheckBox1 = True Then
        OLEObject.Object.Picture = Me.Image160.Picture
    End If
Unload Me
End Sub
 

Jgral

XLDnaute Nouveau
Je vais vous paraître idiot mais je ne capte pas le truc j'ai des notions très limités en VBA et je me suis lancé dans un projet ambitieux. 90% du travail est fait (le plus simple visiblement) ne reste plus qu'a copié les images mais j'y arrive pas pourriez vous avoir la gentille de m'écrire le bout de code qu'il me manque svp

VB:
Private Sub CommandButton1_Click() 'Bouton Valider
    If CheckBox1 = True Then
    ' C'est ici que je ne sais pas quoi mettre
    End If
Unload Me
End Sub

Je vous invite à regarder le fichier svp
 

Dranreb

XLDnaute Barbatruc
Dans un nouveau classeur l'enregistreur de macro m'a produit ce brouillon :
VB:
Option Explicit

Sub Macro1()
'
' Macro1 Macro
'

'
    ActiveSheet.OLEObjects.Add(ClassType:="Forms.Image.1", Link:=False, _
        DisplayAsIcon:=False, Left:=113.25, Top:=31.5, Width:=144, Height:= _
        114.75).Select
End Sub
Donc on devrait pouvoir écrire un truc du genre :
VB:
Private Sub CommandButton1_Click() 'Bouton Valider
   Dim OOt As OLEObject
   If CheckBox1.Value Then
      Set OOt = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Image.1", Link:=False, _
         DisplayAsIcon:=False, Left:=113.25, Top:=31.5, Width:=144, Height:=114.75)
      OOt.Object.Picture = Me.image160.Picture
      End If
   End Sub
 
Dernière édition:

Jgral

XLDnaute Nouveau
J'ai trouvé une solution par mes propres moyen Dranreb merci de votre temps et aide mais je n'ai pas réussit à mettre en place ce que vous me proposiez.

Voici ce que j'ai fait :

VB:
Private Sub CommandButton1_Click() 'Bouton Valider
    If CheckBox1 = True Then
        Sheets("Eléments").Shapes("Image1").Copy
        Sheets("Concepteur étude").Paste
    End If
    If CheckBox2 = True Then
        Sheets("Eléments").Shapes("Image2").Copy
        Sheets("Concepteur étude").Paste
    End If
    If CheckBox3 = True Then
        Sheets("Eléments").Shapes("Image3").Copy
        Sheets("Concepteur étude").Paste
    End If
    If CheckBox4 = True Then
        Sheets("Eléments").Shapes("Image4").Copy
        Sheets("Concepteur étude").Paste
    End If
    If CheckBox5 = True Then
        Sheets("Eléments").Shapes("Image5").Copy
        Sheets("Concepteur étude").Paste
    End If
    If CheckBox6 = True Then
        Sheets("Eléments").Shapes("Image6").Copy
        Sheets("Concepteur étude").Paste
    End If
    If CheckBox7 = True Then
        Sheets("Eléments").Shapes("Image7").Copy
        Sheets("Concepteur étude").Paste
    End If
    If CheckBox8 = True Then
        Sheets("Eléments").Shapes("Image8").Copy
        Sheets("Concepteur étude").Paste
    End If
    If CheckBox9 = True Then
        Sheets("Eléments").Shapes("Image9").Copy
        Sheets("Concepteur étude").Paste
    End If
    If CheckBox10 = True Then
        Sheets("Eléments").Shapes("Image10").Copy
        Sheets("Concepteur étude").Paste
    End If
    If CheckBox11 = True Then
        Sheets("Eléments").Shapes("Image11").Copy
        Sheets("Concepteur étude").Paste
    End If
    If CheckBox12 = True Then
        Sheets("Eléments").Shapes("Image12").Copy
        Sheets("Concepteur étude").Paste
    End If
    If CheckBox13 = True Then
        Sheets("Eléments").Shapes("Image13").Copy
        Sheets("Concepteur étude").Paste
    End If
    If CheckBox14 = True Then
        Sheets("Eléments").Shapes("Image14").Copy
        Sheets("Concepteur étude").Paste
    End If
    If CheckBox15 = True Then
        Sheets("Eléments").Shapes("Image15").Copy
        Sheets("Concepteur étude").Paste
    End If
Unload Me
End Sub

J'ai bien conscience que cela peut-être améliorer par une boucle mais n'étant pas un pro j'en resterai là je pense.

Encore merci pour votre aide.

Quant à job75 j'espère que vous n'êtes pas enseignant car en plus d'être particulièrement agressif dans vos réponses vous n'êtes pas pédagogue pour un sous !!!
 

job75

XLDnaute Barbatruc
Quant à job75 j'espère que vous n'êtes pas enseignant car en plus d'être particulièrement agressif dans vos réponses vous n'êtes pas pédagogue pour un sous !!!
Je vous excuse parce que c'est votre 1ère discussion, vous apprendrez sûrement à mieux me connaître.

@ Bernard : comme tu vois tout ce que veut notre ami c'est empiler des Shapes, les objets ActiveX ne feront donc pas l'affaire.
 

job75

XLDnaute Barbatruc
Pour terminer je ferai quand même remarquer que c'est grâce à ma "pédagogie" que Jgral a abandonné l'idée de copier les images de l'UserForm.

Je simplifierai aussi sa dernière macro :
VB:
Private Sub CommandButton1_Click() 'Bouton Valider
Dim i
For i = 1 To 15
    If Me("CheckBox" & i) Then
        Sheets("Eléments").Shapes("Image" & i).Copy
        Sheets("Concepteur étude").Paste
    End If
Next
End Sub
Tout en maintenant que ça n'a pas de sens.
 

Jgral

XLDnaute Nouveau
Vous ne comprenez visiblement pas le sens mais il y en a puisque c'est une demande qui vient de mes utilisateurs... Bref

De plus je n'ai rien abandonné j'ai juste trouvé quelqu'un qui m'as conseillé de faire de cette manière ce que j'ai fais.

PS : Mes utilisateurs sont ravis...
 

Discussions similaires

Statistiques des forums

Discussions
312 215
Messages
2 086 330
Membres
103 188
dernier inscrit
evebar