XL 2013 insertion image dans cellule

bredeche · 5 Juillet 2019

bonjour
j'ai un formulaire qui me permet d'inséré une image dans un onglet qui se crée a l’emplacement H20 et le chemin dans un tableau en aw

pour les éléments qui s 'inscris dans la cellule de l'onglet cela me place que des chiffres je ne comprend pas voici mon code

VB:

Option Explicit


Private Sub CommandButton2_Click() 'Bouton VALIDER
Dim NewLig As Long
Dim laconcat As String


 
 'ELEMENT ENREGISTRE DANS LE TABLEAU PRESENTATION RECAP
  With Sheets("02-Présentation Recap")
    
        NewLig = Application.Max(10, .Range("A" & Rows.Count).End(xlUp).Row + 1)
        .Range("A" & NewLig).Value = Application.WorksheetFunction.Max(Range("A:A")) + 1
      
      laconcat = ComboBox4.Value & " _ " & TextBoxfiche.Text & " _ " & TextBoxannée.Text & " " & ComboBox5.Value
   .Range("B" & NewLig).Value = laconcat
   .Range("C" & NewLig).Value = TextBoxobjet
    .Range("D" & NewLig).Value = ComboBox1
    
     End With
    
    'ELEMENT ENREGISTRE DANS LE TABLEAU  RECAP
    With Sheets("00-Recap")
    
    
        NewLig = Application.Max(10, .Range("A" & Rows.Count).End(xlUp).Row + 1)
        .Range("A" & NewLig).Value = Application.WorksheetFunction.Max(Range("A:A")) + 1
      
        .Range("C" & NewLig).Value = TextBoxobjet
        .Range("Y" & NewLig).Value = ComboBox4
        .Range("Z" & NewLig).Value = TextBoxfiche
        .Range("AA" & NewLig).Value = CDate(TextBoxdate)
        .Range("AB" & NewLig).Value = TextBoximputation
        .Range("AC" & NewLig).Value = TextBoxlocalisation
        .Range("AD" & NewLig).Value = ComboBox1
        .Range("D" & NewLig).Value = ComboBox1
        .Range("AE" & NewLig).Value = TextBoxannée
        .Range("AF" & NewLig).Value = CheckBox1
        .Range("AG" & NewLig).Value = CheckBox2
        .Range("AH" & NewLig).Value = CheckBox3
        .Range("AI" & NewLig).Value = TextBoxconstat
        .Range("AJ" & NewLig).Value = TextBoxrisque
        
        .Range("AK" & NewLig).Value = TextBoxorigine
        .Range("AL" & NewLig).Value = CheckBox4
        .Range("AM" & NewLig).Value = CheckBox5
        .Range("AN" & NewLig).Value = CheckBox6
        
        
        .Range("AO" & NewLig).Value = TextBoxtravaux
        .Range("AP" & NewLig).Value = CheckBox7
        .Range("AQ" & NewLig).Value = CheckBox8
        .Range("AR" & NewLig).Value = CheckBox9
        
        .Range("AS" & NewLig).Value = TextBoxobservation
        
        .Range("AT" & NewLig).Value = TextBoxconstructeur
        .Range("AU" & NewLig).Value = TextBoxdureevie1
        .Range("AV" & NewLig).Value = TextBoxdureevie2
        .Range("AW" & NewLig).Value = CHEMIN
        
   laconcat = ComboBox4.Value & " _ " & TextBoxfiche.Text & " _ " & TextBoxannée.Text & " " & ComboBox5.Value
   .Range("B" & NewLig).Value = laconcat
  
    End With
   Application.ScreenUpdating = False
    'On crée les onglets
        'on copie le modèle en dernier
        Worksheets("03-TRAME").Copy After:=Worksheets(ThisWorkbook.Sheets.Count)
            With ActiveSheet
            .Name = Worksheets("00-RECAP").Range("B" & NewLig)    'je renome
            'Je remplit mon modèle comme je veut...
            .Range("B3") = TextBoxobjet
            .Range("A6") = TextBoxfiche
            .Range("B6") = TextBoxdate
            .Range("C6") = TextBoximputation
            .Range("D6") = TextBoxlocalisation
            .Range("E6") = ComboBox1
            .Range("F6") = TextBoxannée
            .Range("G6") = ComboBox4
            
            .Range("A9") = TextBoxconstat
            .Range("E11") = CheckBox1
            .Range("E12") = CheckBox2
            .Range("E13") = CheckBox3
            
            .Range("A16") = TextBoxrisque
            
            .Range("A21") = TextBoxorigine
            .Range("E23") = CheckBox4
            .Range("E24") = CheckBox5
            .Range("E25") = CheckBox6
            
            
            .Range("A28") = TextBoxtravaux
            .Range("E31") = CheckBox7
            .Range("E32") = CheckBox8
            .Range("E33") = CheckBox9
            
            .Range("A36") = TextBoxobservation
            
            .Range("H15") = TextBoxconstructeur
            
            .Range("K17") = TextBoxdureevie1
            .Range("K18") = TextBoxdureevie2
            
            [h20].Select
    ActiveSheet.Pictures.Insert (Me.Image1.Picture)
          
        End With
            Application.ScreenUpdating = True
    Unload UserForm1
End Sub

 Private Sub Textboxdate_Change()
'Code permettant de mettre une date au format 00/00/0000 dans une textbox
Dim valeur As Byte
TextBoxdate.MaxLength = 8 'nb caractères maxi autorisé dans le textbox
valeur = Len(TextBoxdate)
If valeur = 2 Or valeur = 5 Then TextBoxdate = TextBoxdate & "/"

End Sub

Private Sub ComboBox4_Change()
    Dim c As Range, sh As Worksheet
    Set sh = Worksheets("01-données")
    Set c = sh.[B:B].Find(ComboBox4, LookIn:=xlValues, lookat:=xlWhole)
    TextBoximputation = IIf(c Is Nothing, "", c.Offset(, 1))
End Sub

Private Sub CommandButton3_Click()
 Dim NF
  NF = Application.GetOpenFilename("Fichiers jpg,*.jpg")
  If Not NF = False Then
    Me.CHEMIN = NF
    Me.Image1.Picture = LoadPicture(NF)
    Me.Image1.PictureSizeMode = fmPictureSizeModeStretch
  End If

merci de votre aide par avance
 
End Sub

Private Sub CommandButton4_Click()
Image1.Picture = LoadPicture("")
End Sub

bredeche · 8 Juillet 2019

je me permet de relance mon sujet
pouvez vous m'aider

Dranreb · 8 Juillet 2019

Bonjour.
Essayez comme ça :

VB:

Dim Img As MSForms.Image, Cel As Range
Set Cel = ActiveSheet.Cells(20, "H")
Set Img = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Image.1", Link:=False, DisplayAsIcon:=False, _
   Left:=Cel.Left, Top:=Cel.Top, Width:=Me.Image1.Width, Height:=Me.Image1.Height).Object
Img.Picture = Me.Image1.Picture

Remarque: ce ne sera pas une image de formulaire, mais une ActiveX.
ActiveSheet.Pictures.Insert ne doit être suivi que d'une référence à un fichier image.

bredeche · 8 Juillet 2019

Dranreb à dit:
Bonjour.
Essayez comme ça :

VB:

Dim Img As MSForms.Image, Cel As Range Set Cel = ActiveSheet.Cells(20, "H") Set Img = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Image.1", Link:=False, DisplayAsIcon:=False, _ Left:=Cel.Left, Top:=Cel.Top, Width:=Me.Image1.Width, Height:=Me.Image1.Height).Object Img.Picture = Me.Image1.Picture

Remarque: ce ne sera pas une image de formulaire, mais une ActiveX.
ActiveSheet.Pictures.Insert ne doit être suivi que d'une référence à un fichier image.

super merci pour le code
mais l'image est zommer
j'ai placer ce code mais cela ne marche pas

VB:

 Me.Image1.PictureSizeMode = fmPictureSizeModeStretch

avant ma cellule h20 est fusionné entre (h20:l38) (cadre de mon image
maintenant que c est un activex ma photo doit être dans mon carre fusionne
que dois je faireou rentre dans mon code

Dranreb · 8 Juillet 2019

Peut être devriez vous enlever de l'UserForm la création de l'image ActiveX et en régler ses propriétés une fois pour toute en Mode Création du menu Développeur

bredeche · 8 Juillet 2019

Dranreb à dit:
Peut être devriez vous enlever de l'UserForm la création de l'image ActiveX et en régler ses propriétés une fois pour toute en Mode Création du menu Développeur

je suis désoler je suis novice je comprend pas
je veux que mon image s'affiche dans l'userform pourquoi la supprimer!!!

Dranreb · 8 Juillet 2019

Non je parlais de l'image dans la feuille.

bredeche · 8 Juillet 2019

je suis vraiment désolé mais je comprend pas
l'image dans ma feuille "fiche" j'en ai besoin
je voudrais bien vous envoyé mon fichier mais il est lourd

Dranreb · 8 Juillet 2019

Je ne vous ai pas dit de la supprimer, seulement de ne plus chaque fois la recréer par ActiveSheet.OLEObjects.Add
Réglez ses caractéristiques une fois pour toutes.
Mais vous pouvez quand même aussi les ajuster par code si vous voulez.
Par ActiveSheet c'est malcomode. Il vaut mieux le nom de l'objet Worksheet représentant votre feuille "Fiche", un point, enfin le nom de l'image ActiveX.

bredeche · 8 Juillet 2019

je suis obligé de cree a chaque fois un nouveau active x par rapport a ton car l'image n 'est pas la même dans chaque nouvelle fiche créé
d’où l’adaptation de l'image dans mes cellule de h20 a l38

VB:

 Me.Image1.PictureSizeMode = fmPictureSizeModeStretch

est ce que cela ne va pas alourdir mon fichier avec des images format activex

est ce que je peux plutot afficher l'image via son chemin enregistre dans un textbox ou un cellule dans mon tableau

encore merci de ton aide

Code:

Option Explicit


Private Sub CommandButton2_Click() 'Bouton VALIDER
Dim NewLig As Long
Dim laconcat As String
Dim Img As MSForms.Image, Cel As Range


 
 'ELEMENT ENREGISTRE DANS LE TABLEAU PRESENTATION RECAP
  With Sheets("02-Présentation Recap")
    
        NewLig = Application.Max(10, .Range("A" & Rows.Count).End(xlUp).Row + 1)
        .Range("A" & NewLig).Value = Application.WorksheetFunction.Max(Range("A:A")) + 1
      
      laconcat = ComboBox4.Value & " _ " & TextBoxfiche.Text & " _ " & TextBoxannée.Text
   .Range("B" & NewLig).Value = laconcat
   .Range("C" & NewLig).Value = TextBoxobjet
    .Range("D" & NewLig).Value = ComboBox1
    
     End With
    
    'ELEMENT ENREGISTRE DANS LE TABLEAU  RECAP
    With Sheets("00-Recap")
    
    
        NewLig = Application.Max(10, .Range("A" & Rows.Count).End(xlUp).Row + 1)
        .Range("A" & NewLig).Value = Application.WorksheetFunction.Max(Range("A:A")) + 1
      
        .Range("C" & NewLig).Value = TextBoxobjet
        .Range("Y" & NewLig).Value = ComboBox4
        .Range("Z" & NewLig).Value = TextBoxfiche
        .Range("AA" & NewLig).Value = CDate(TextBoxdate)
        .Range("AB" & NewLig).Value = TextBoximputation
        .Range("AC" & NewLig).Value = TextBoxlocalisation
        .Range("AD" & NewLig).Value = ComboBox1
        .Range("D" & NewLig).Value = ComboBox1
        .Range("AE" & NewLig).Value = TextBoxannée
        .Range("AF" & NewLig).Value = CheckBox1
        .Range("AG" & NewLig).Value = CheckBox2
        .Range("AH" & NewLig).Value = CheckBox3
        .Range("AI" & NewLig).Value = TextBoxconstat
        .Range("AJ" & NewLig).Value = TextBoxrisque
        
        .Range("AK" & NewLig).Value = TextBoxorigine
        .Range("AL" & NewLig).Value = CheckBox4
        .Range("AM" & NewLig).Value = CheckBox5
        .Range("AN" & NewLig).Value = CheckBox6
        
        
        .Range("AO" & NewLig).Value = TextBoxtravaux
        .Range("AP" & NewLig).Value = CheckBox7
        .Range("AQ" & NewLig).Value = CheckBox8
        .Range("AR" & NewLig).Value = CheckBox9
        
        .Range("AS" & NewLig).Value = TextBoxobservation
        
        .Range("AT" & NewLig).Value = TextBoxconstructeur
        .Range("AU" & NewLig).Value = TextBoxdureevie1
        .Range("AV" & NewLig).Value = TextBoxdureevie2
        .Range("AW" & NewLig).Value = CHEMIN
        
   laconcat = ComboBox4.Value & " _ " & TextBoxfiche.Text & " _ " & TextBoxannée.Text
   .Range("B" & NewLig).Value = laconcat
  
    End With
   Application.ScreenUpdating = False
    'On crée les onglets
        'on copie le modèle en dernier
        Worksheets("03-TRAME").Copy After:=Worksheets(ThisWorkbook.Sheets.Count)
            With ActiveSheet
            .Name = Worksheets("00-RECAP").Range("B" & NewLig)    'je renome
            'Je remplit mon modèle comme je veut...
            
             Range("K1") = ActiveSheet.Name
            
            
            .Range("B3") = TextBoxobjet
            .Range("A6") = TextBoxfiche
            .Range("B6") = TextBoxdate
            .Range("C6") = TextBoximputation
            .Range("D6") = TextBoxlocalisation
            .Range("E6") = ComboBox1
            .Range("F6") = TextBoxannée
            .Range("G6") = ComboBox4
            
            .Range("A9") = TextBoxconstat
            .Range("E11") = CheckBox1
            .Range("E12") = CheckBox2
            .Range("E13") = CheckBox3
            
            .Range("A16") = TextBoxrisque
            
            .Range("A21") = TextBoxorigine
            .Range("E23") = CheckBox4
            .Range("E24") = CheckBox5
            .Range("E25") = CheckBox6
            
            
            .Range("A28") = TextBoxtravaux
            .Range("E31") = CheckBox7
            .Range("E32") = CheckBox8
            .Range("E33") = CheckBox9
            
            .Range("A36") = TextBoxobservation
            
            .Range("H15") = TextBoxconstructeur
            
            .Range("K17") = TextBoxdureevie1
            .Range("K18") = TextBoxdureevie2
            


Set Cel = ActiveSheet.Cells(20, "H")
Set Img = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Image.1", Link:=False, DisplayAsIcon:=False, _
   Left:=Cel.Left, Top:=Cel.Top, Width:=Me.Image1.Width, Height:=Me.Image1.Height).Object
Img.Picture = Me.Image1.Picture

        End With
        
            Application.ScreenUpdating = True
    Unload UserForm1
End Sub

 Private Sub Textboxdate_Change()
'Code permettant de mettre une date au format 00/00/0000 dans une textbox
Dim valeur As Byte
TextBoxdate.MaxLength = 8 'nb caractères maxi autorisé dans le textbox
valeur = Len(TextBoxdate)
If valeur = 2 Or valeur = 5 Then TextBoxdate = TextBoxdate & "/"

End Sub

Private Sub ComboBox4_Change()
    Dim c As Range, sh As Worksheet
    Set sh = Worksheets("01-données")
    Set c = sh.[B:B].Find(ComboBox4, LookIn:=xlValues, lookat:=xlWhole)
    TextBoximputation = IIf(c Is Nothing, "", c.Offset(, 1))
End Sub

Private Sub CommandButton3_Click()
 Dim NF
  NF = Application.GetOpenFilename("Fichiers jpg,*.jpg")
  If Not NF = False Then
    Me.CHEMIN = NF
    Me.Image1.Picture = LoadPicture(NF)
    Me.Image1.PictureSizeMode = fmPictureSizeModeStretch
  End If
 
End Sub

Private Sub CommandButton4_Click()
Image1.Picture = LoadPicture("")
End Sub

Dranreb · 8 Juillet 2019

Non, pas obligé de le créer chaque fois, seulement changer sa propriété Picture. Mais on peut si on veut changer d'autres choses.
Par exemple si on a mis "ImgPhoto" comme propriété Name de l'image ActiveX implantée dans une feuille Excel, cette entité étant, dans la rubrique Microsoft Excel Objets, représentée par un objet Worksheet nommé Feuil1 :

VB:

Private Sub CommandButton1_Click()
   Dim RngCadre As Range
   Set RngCadre = Feuil1.[H20].MergeArea
   With Feuil1.ImgPhoto
      .Left = RngCadre.Left: .Top = RngCadre.Top
      .Width = RngCadre.Width: .Height = RngCadre.Height
      .Picture = Me.Image1.Picture
      .PictureSizeMode = fmPictureSizeModeZoom
      End With
   End Sub

bredeche · 8 Juillet 2019

donc pour ma part j'ai fait cela

VB:

Private Sub image1_Click()
 Dim RngCadre As Range
   Set RngCadre = Feuil1.[H20].MergeArea
   With Feuil1.Image1
      .Left = RngCadre.Left: .Top = RngCadre.Top
      .Width = RngCadre.Width: .Height = RngCadre.Height
      .Picture = Me.Image1.Picture
      .PictureSizeMode = fmPictureSizeModeZoom
      End With
   End Sub

ce code se trouvant dans ma trame qui permet de crée chaque fiche
et comme chaque image va appeler image 1 de chaque feuille cela devrait marche
mais cela met une erreur
"erreur de compilation
donné introuvable

Dranreb · 8 Juillet 2019

Comment ça créer chaque fiche ?
Vous voulez dire actualisez la seule et unique feuille de Fiche selon les données de la fiche particulière à y faire momentanément apparaître, j'espère !…

bredeche · 8 Juillet 2019

Dranreb à dit:
Comment ça créer chaque fiche ?
Vous voulez dire actualisez la seule et unique feuille de Fiche selon les données de la fiche particulière à y faire momentanément apparaître, j'espère !…

je me suis fais mal comprendre désolé
la fiche ou se trouve l'image inséré par un userform est créé a partir d'une trame
j'ai placé le code expliqué ci dessus afin que chaque fois que je clique sur l'image de la fiche "cree renommé etc.." elle se redimensionne
mais cela me mais une erreur

bredeche · 8 Juillet 2019

bredeche à dit:
je me suis fais mal comprendre désolé
la fiche ou se trouve l'image inséré par un userform est créé a partir d'une trame
j'ai placé le code expliqué ci dessus afin que chaque fois que je clique sur l'image de la fiche "cree renommé etc.." elle se redimensionne
mais cela me mais une erreur

ma trame cest

et quand la photo s’insère cela fait cela

voila pourquoi cela me bloque

XL 2013 insertion image dans cellule

bredeche

XLDnaute Occasionnel

bredeche

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

bredeche

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

bredeche

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

bredeche

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

bredeche

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

bredeche

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

bredeche

XLDnaute Occasionnel

bredeche

XLDnaute Occasionnel

Discussions similaires