XL 2013 insertion image dans cellule

bredeche

XLDnaute Occasionnel
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
 

Dranreb

XLDnaute Barbatruc
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.
 
Dernière édition:

bredeche

XLDnaute Occasionnel
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

XLDnaute Barbatruc
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.
 
Dernière édition:

bredeche

XLDnaute Occasionnel
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

XLDnaute Barbatruc
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
 
Dernière édition:

bredeche

XLDnaute Occasionnel
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
 

bredeche

XLDnaute Occasionnel
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

XLDnaute Occasionnel
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
1035233


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

voila pourquoi cela me bloque
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 892
Membres
101 831
dernier inscrit
gillec