XL 2010 Insérer image dans une zone de texte

madoupa · 3 Décembre 2022

Bonjour tout le monde
j'ai ce code pour insérer des images, SVP je veux modifier l'emplacement pour les insérer dans des zones de texte
merci

VB:

 Dim Emplacement As Range
  Dim img As Object
  Dim ShapeObj As Shape, i%
 
  'Boucle pour supprimer les images sauf le bouton
  For Each ShapeObj In Sheets("feuil1").Shapes
      If ShapeObj.Name = "Cible1" Then ShapeObj.Delete
  Next ShapeObj
  Sheets("feuil1").Activate
  If Application.Dialogs(xlDialogInsertPicture).Show Then
      For i = 1 To 2 'Boucle pour 2 images
        If i = 1 Then '1ère image
          Set Emplacement = Range("I15:I20") '1er emplacement
        Else 'sinon pour 2ème image, copie de la première
          ActiveSheet.Shapes.Range(Array("Cible1")).Select
          Selection.Copy
          ActiveSheet.Paste
          Set Emplacement = Range("I41:I46") '2ème emplacement
        End If
        Set img = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)
        With img.ShapeRange
          'Nommer l'image insérée (Pour la supprimer plus facilement ensuite)
          .Name = "Cible1" 'Nomme les images 1 ou 2
          .LockAspectRatio = msoFalse
          .Left = Emplacement.Left
          .Top = Emplacement.Top
          .Height = Emplacement.Height
          .Width = Emplacement.Width
          .ZOrder msoSendToBack
      End With
      Next i

kiki29 · 3 Décembre 2022

Salut, va voir sur JBoisgontier

madoupa · 3 Décembre 2022

kiki29 à dit:
Salut, va voir sur JBoisgontier

salut
j'ai pas trouvé

madoupa · 4 Décembre 2022

kiki29 à dit:
Salut, va voir sur JBoisgontier

Bonjour
Svp, je connaiis pas beaucoup on vba, je veux remplacer set Emplacement = Range("I41:I46") par un emplacement zone de texte (textbox)
merci d'avance

p56 · 4 Décembre 2022

Bonjour à tous,
Voici du code fonctionnel

VB:

' Auteur : Pierre - P56 - http://tatiak.canalblog.com/
Sub Image_dans_Texte()
Dim ndf As Variant, W As Single, H As Single

    ndf = Choix_Image
    If Not ndf = False Then
        On Error Resume Next
        ActiveSheet.Shapes("_Test").Delete
        
        With ActiveSheet.Pictures.Insert(ndf)
            W = .Width
            H = .Height
            .Delete
        End With
    
        With ActiveSheet.Shapes.AddTextbox(1, 100, 50, W, H)
            .Fill.UserPicture ndf
            .Name = "_Test"
        End With
    End If
End Sub

Function Choix_Image() As String
    ChDrive (Left(ActiveWorkbook.Path, 1))
    ChDir ActiveWorkbook.Path
    Choix_Image = Application.GetOpenFilename("Fichiers images,*.jpg;*.gif;*.png")
End Function

P.

patricktoulon · 4 Décembre 2022

re
Bonjour
bien vu tatiak je n'y ai pas pensé a fillformat

madoupa · 4 Décembre 2022

p56 à dit:

Bonjour à tous,
Voici du code fonctionnel

VB:

' Auteur : Pierre - P56 - http://tatiak.canalblog.com/
Sub Image_dans_Texte()
Dim ndf As Variant, W As Single, H As Single

    ndf = Choix_Image
    If Not ndf = False Then
        On Error Resume Next
        ActiveSheet.Shapes("_Test").Delete
       
        With ActiveSheet.Pictures.Insert(ndf)
            W = .Width
            H = .Height
            .Delete
        End With
   
        With ActiveSheet.Shapes.AddTextbox(1, 100, 50, W, H)
            .Fill.UserPicture ndf
            .Name = "_Test"
        End With
    End If
End Sub

Function Choix_Image() As String
    ChDrive (Left(ActiveWorkbook.Path, 1))
    ChDir ActiveWorkbook.Path
    Choix_Image = Application.GetOpenFilename("Fichiers images,*.jpg;*.gif;*.png")
End Function

P.

Merci, ça marche bien ton code
mais ce que je veux c'est d'insérer une image sur un textbox qui est déjà sur ma feuil pour ne pas prendre la forme des cellules, car l'image est un tampon rond.
merci

p56 · 4 Décembre 2022

Et bien le principe est le même. Ici du code pour remplacer l'image du textbox nommé "_Test", en gardant les dimensions de l'image choisie

VB:

' Auteur : Pierre - P56 - http://tatiak.canalblog.com/
Sub Remplace_Image_dans_Texte()
Dim ndf As Variant, W As Single, H As Single

    ndf = Choix_Image
    If Not ndf = False Then
        With ActiveSheet.Pictures.Insert(ndf)
            W = .Width
            H = .Height
            .Delete
        End With
       
        With ActiveSheet.Shapes("_Test")
            .Width = W
            .Height = H
            .Fill.UserPicture ndf
        End With
    End If
End Sub

Function Choix_Image() As String
    ChDrive (Left(ActiveWorkbook.Path, 1))
    ChDir ActiveWorkbook.Path
    Choix_Image = Application.GetOpenFilename("Fichiers images,*.jpg;*.gif;*.png")
End Function

patricktoulon · 4 Décembre 2022

re
@p56 il serait intéressant de remplir le textbox en gardant le ration de l'image
faire un peu comme un encart journal

si ça vous intéresse je sais comment faire

madoupa · 4 Décembre 2022

p56 à dit:

Et bien le principe est le même. Ici du code pour remplacer l'image du textbox nommé "_Test", en gardant les dimensions de l'image choisie

VB:

' Auteur : Pierre - P56 - http://tatiak.canalblog.com/
Sub Remplace_Image_dans_Texte()
Dim ndf As Variant, W As Single, H As Single

    ndf = Choix_Image
    If Not ndf = False Then
        With ActiveSheet.Pictures.Insert(ndf)
            W = .Width
            H = .Height
            .Delete
        End With
      
        With ActiveSheet.Shapes("_Test")
            .Width = W
            .Height = H
            .Fill.UserPicture ndf
        End With
    End If
End Sub

Function Choix_Image() As String
    ChDrive (Left(ActiveWorkbook.Path, 1))
    ChDir ActiveWorkbook.Path
    Choix_Image = Application.GetOpenFilename("Fichiers images,*.jpg;*.gif;*.png")
End Function

Merci beaucoup
il reste un seul souci c'est le code pour enlever le trait du contour de la textbox ça m'aidera beaucoup
merci d'avance

p56 · 5 Décembre 2022

Trés simple :

VB:

With ActiveSheet.Shapes("_Test")
    .Line.Visible = msoFalse
    ' etc ...

patricktoulon · 6 Décembre 2022

re
Bonjour a tous
j'aurais une question
ajouter un textbox formulaire par vba ok
mais par le menu le bouton est grisé(déactivé)
quelqu'un pourrait me dire pourquoi ?

p56 · 6 Décembre 2022

Bonjour à tous,
Encore très simple : cf Menu Insertion/Texte/Zone de texte

patricktoulon · 6 Décembre 2022

re
ok @p56 reçu

guy72 · 13 Septembre 2023

Comment ajouter une image dans une zone de texte si la cellule G31 contient un nombre de plus de 21

XL 2010 Insérer image dans une zone de texte

madoupa

XLDnaute Nouveau

kiki29

XLDnaute Barbatruc

madoupa

XLDnaute Nouveau

madoupa

XLDnaute Nouveau

p56

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

madoupa

XLDnaute Nouveau

p56

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

madoupa

XLDnaute Nouveau

p56

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

p56

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

guy72

XLDnaute Impliqué

Discussions similaires