Contrôle d'image VBA Résolu/Fermé

Question

Bonjour tout le monde,

Je souhaite créer dans une feuille un contrôle d'image. Voici le code pour l'instant :

ActiveSheet.OLEObjects.Add(ClassType:="Forms.Image.1", Link:=False, _
        DisplayAsIcon:=False, Left:=514.5, Top:=101.25, Width:=311.25, Height _
        :=212.25).Select

C'est ce qui me permet de créer le contrôle d'image, puis de modifier sa position et ses dimensions. Mais j'aimerais également pouvoir modifier les paramètres "PictureSizeMode", "BackColor" et "BorderColor". Je souhaite changer la couleur en blanc pour que le contrôle n'apparaisse pas à l'impression (si vous avez une meilleure idée).

Merci d'avance pour vos réponses.

cs_Le Pivert · Answer

Bonjour,

comme ceci

Sub AddImageControl()
Dim btn As OLEObject
Set btn = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Image.1", Link:=False, _
DisplayAsIcon:=False, Left:=514.5, Top:=101.25, Width:=311.25, Height _
:=212.25)
With btn
    .Object.Picture = LoadPicture("C:\chemin fichier image.jpg") 'chemin de l'image a adapter
    .Object.PictureSizeMode = fmPictureSizeModeZoom 'a adapter
     .Object.BorderColor = RGB(255, 0, 0) 'rouge a adapter
      .Object.BackColor = RGB(0, 128, 64) 'vert a adapter
End With
End Sub

cs_Le Pivert · Answer

btn est une variable, tu mets ce que tu veux. 

Il faut savoir que ce code crée à chaque fois un contrôle image. Donc si tu veux mettre une image différente, il faut supprimer le contrôle. voici le code:

Option Explicit
Dim chemin
Private Sub CommandButton1_Click()
chemin = Application _
    .GetOpenFilename("Images Files (*.jpg), *.jpg")
If chemin <> False Then
EffaceImages
    AddImageControl
End If
End Sub
Sub AddImageControl()
Dim btn As OLEObject
Set btn = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Image.1", Link:=False, _
DisplayAsIcon:=False, Left:=514.5, Top:=101.25, Width:=311.25, Height _
:=212.25)
With btn
    .Object.Picture = LoadPicture(chemin) 'chemin de l'image
    .Object.PictureSizeMode = fmPictureSizeModeZoom
     .Object.BorderColor = RGB(255, 0, 0) 'rouge
      .Object.BackColor = RGB(0, 128, 64) 'vert
End With
End Sub
Sub EffaceImages()
 Dim x As Shape
 For Each x In ActiveSheet.Shapes
         x.Delete
    Next x
 End Sub


l'image en jpg est déjà une image compressée!

Contrôle d'image VBA

2 réponses

Discussions similaires

Newsletters