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"

Jgral · 2 Décembre 2019

Vous ne voulez pas m'aider on dirait tant pis je vais continuer à chercher en espérant que quelqu'un veuille bien m'aider.

Jgral · 2 Décembre 2019

Je précise que les futurs utilisateurs ne manient pas très bien l'outils informatique, le but de la manoeuvre est de leur simplifier au maximum les choses en restant sur une seule page.

job75 · 2 Décembre 2019

Jgral à dit:
le but de la manoeuvre est de leur simplifier au maximum les choses en restant sur une seule page.

Eh bien dans la page en question mettez toutes les Shapes dont ils auront besoin, et surtout pas supperposées !!!

Ensuite copier-coller tout le monde sait faire ça.

Dranreb · 2 Décembre 2019

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 · 2 Décembre 2019

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

Dranreb · 2 Décembre 2019

Il faut d'abord isoler l'OLEObject ou le créer par Set Img = OLEObjects.Add("MSForms.Image.1")

Jgral · 2 Décembre 2019

Je n'y arrive pas

Dranreb · 2 Décembre 2019

Précisez une expression Worksheet suivie d'un point devant, qu'il sache quelle collection OLEObjects est à considérer.

Jgral · 2 Décembre 2019

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 · 2 Décembre 2019

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

Jgral · 2 Décembre 2019

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 · 2 Décembre 2019

Jgral à dit:
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.

Dranreb · 2 Décembre 2019

Bonsoir Job75.
Il avait pourtant commencé par vouloir utiliser les Images de son UserForm. Mais bien sûr s'il les a aussi sous forme de Shape …

job75 · 2 Décembre 2019

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 · 3 Décembre 2019

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...

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

Jgral

XLDnaute Nouveau

patricktoulon

Jgral

XLDnaute Nouveau

Jgral

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

Jgral

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

Jgral

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

Jgral

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

Jgral

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Jgral

XLDnaute Nouveau

Discussions similaires