redimensionner image lors d'une insertion automatique dans une cellule fusionnée

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion jeromeN95
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
jeromeN95

jeromeN95

XLDnaute Impliqué
Bonjour a tous,
j'ai un bout de code qui insert une image selon condition...
Mais l'image issu d'une recherche stocké sur le pc à une taille variable.

Je souhaite la redimentionnée automatiquement SVP :
Ce bout de code ne me convient pas vraiment...
Code: 
.LockAspectRatio = False ' proportions d'origine lorsque vous la redimensionnez'.Top = ActiveCell.Top ' haut de la cellule
.Left = ActiveCell.Left ' gauche de la cellule
.Height = ActiveCell.RowHeight ' hauteur de la cellule
.Width = ActiveCell.Width ' largeur de la cellule

Merci😱
 
Trier par date Trier par votes
Re : redimensionner image lors d'une insertion automatique dans une cellule fusionnée

Bonjour jeromeN95,

A adapter :

Code: 
Sub Image()
Dim c As Range, a As Range
Set c = ActiveCell
Set a = c.MergeArea
With ActiveSheet.Shapes("Picture 1") 'à adapter
  .LockAspectRatio = True 'pour conserver les proportions de l'image
  .Top = c.Top
  .Left = c.Left
  If .Height / .Width > a.Height / a.Width Then
    .Height = a.Height
  Else
    .Width = a.Width
  End If
End With
End Sub
A+
 
Vote positif 0 Vote négatif
Re : redimensionner image lors d'une insertion automatique dans une cellule fusionnée

Impecable, ça fonctionne mais reste a adapté l'image inserer :
Code: 
'Insérer Image Doseur
If Me.LstDoseur <> "" Then
    InsertImage "\\sparte.asp.fr\data\adv\photos\" & Me.LstDoseur & ".jpg"
Dim a As Range
Set c = ActiveCell
Set a = c.MergeArea
With ActiveSheet.Shapes("Image 163") 'à adapter pour l'image vennat d'être inserer
  .LockAspectRatio = True 'pour conserver les proportions de l'image
  .Top = c.Top
  .Left = c.Left
  If .Height / .Width > a.Height / a.Width Then
    .Height = a.Height
  Else
    .Width = a.Width
  End If
End With
End If
 
Vote positif 0 Vote négatif
Re : redimensionner image lors d'une insertion automatique dans une cellule fusionnée

J'ai essayer comme ceci mais pas de redimentionnement :
Code: 
'Insérer Image Doseur
If Me.LstDoseur <> "" Then
    InsertImage "\\sparte.asp.fr\data\adv\photos\" & Me.LstDoseur & ".jpg"
    
    'ici
Dim a As Range
Set c = ActiveCell
Set a = c.MergeArea
Set im = "\\sparte.asp.fr\data\adv\photos\" & Me.LstDoseur & ".jpg"
With ActiveSheet.Shapes = im 'à adapter
  .LockAspectRatio = True 'pour conserver les proportions de l'image
  .Top = c.Top
  .Left = c.Left
  If .Height / .Width > a.Height / a.Width Then
    .Height = a.Height
  Else
    .Width = a.Width
  End If
End With
   'ici
End If
 
Vote positif 0 Vote négatif
Re : redimensionner image lors d'une insertion automatique dans une cellule fusionnée

Bonjour,

Le bout de code ci-dessous permet de redimensionner l'image insérée dans une plage à cellules fusionnées !

Sub InsertPicture()
Dim MaSelection As Range
Dim MyPicture As Picture
Dim image$
image = "c:\mon_image.jpg"
Set MaSelection = Selection
MaSelection.Select
Set MyPicture = ActiveSheet.Pictures.Insert(image)
With MyPicture.ShapeRange
.LockAspectRatio = msoFalse
.Height = MaSelection.Height
.Width = MaSelection.Width
End With
MaSelection.Select
End Sub

Cdt, Hamcec.
 
Dernière édition:
Vote positif 0 Vote négatif
Re : redimensionner image lors d'une insertion automatique dans une cellule fusionnée

Re,

Allons allons, vous croyez que ceci à un sens :

With ActiveSheet.Shapes = im 'à adapter 😕

Utilisez 8% d'Excel...

A noter que là on est simplement dans la création d'image, ce n'est plus le sujet du fil.

A+
 
Vote positif 0 Vote négatif
Re : redimensionner image lors d'une insertion automatique dans une cellule fusionnée

Bonjour,
j'ai essayer ceci :
Code: 
'Insérer Image Doseur
If Me.LstDoseur <> "" Then
    InsertImage "\\sparte.asp.fr\data\adv\photos\" & Me.LstDoseur & ".jpg"

Dim MaSelection As Range
Dim MyPicture As Picture
Dim image
image = "c:\mon_image.jpg"
Set MaSelection = Selection
MaSelection.Select
Set MyPicture = ActiveSheet.Pictures.Insert(image)
With MyPicture.ShapeRange
.LockAspectRatio = msoFalse
.Height = MaSelection.Height
.Width = MaSelection.Width
End With
MaSelection.Select
 
Vote positif 0 Vote négatif
Re : redimensionner image lors d'une insertion automatique dans une cellule fusionnée

Si tu veux adapter mon bout de code au tien, il suffit de remplacer "c:\mon_image.jpg" par ton nom de fichier "\\sparte.asp.fr\data\adv\photos\" & Me.LstDoseur & ".jpg", ce qui donne :

Sub InsertPicture()
Dim MaSelection As Range
Dim MyPicture As Picture
Dim image$
If Me.LstDoseur <> "" Then
image = "\\sparte.asp.fr\data\adv\photos\" & Me.LstDoseur & ".jpg"
Set MaSelection = Selection
MaSelection.Select
Set MyPicture = ActiveSheet.Pictures.Insert(image)
With MyPicture.ShapeRange
.LockAspectRatio = msoFalse
.Height = MaSelection.Height
.Width = MaSelection.Width
End With
MaSelection.Select
End If
End Sub

A+, Hamcec.
 
Vote positif 0 Vote négatif
Re : redimensionner image lors d'une insertion automatique dans une cellule fusionnée

Re,

Pas mal du tout, vous avez bien trouvé ShapeRange.

Alors essayez ce code :

Code: 
'Insérer Image Doseur
If Me.LstDoseur <> "" Then
  Dim im As Object, c As Range, a As Range
  Set im = ActiveSheet.Pictures.Insert("\\sparte.asp.fr\data\adv\photos\" & _
    Me.LstDoseur & ".jpg")
  Set c = ActiveCell
  Set a = c.MergeArea
  With im.ShapeRange
    .LockAspectRatio = True 'pour conserver les proportions de l'image
    .Top = c.Top
    .Left = c.Left
    If .Height / .Width > a.Height / a.Width Then
      .Height = a.Height
    Else
      .Width = a.Width
    End If
  End With
End If
A+
 
Vote positif 0 Vote négatif
Re : redimensionner image lors d'une insertion automatique dans une cellule fusionnée

Merci pour le ShapeRange.

Une petite remarque : en fonction de la plage fusionnée cible, les proportions de l'image ne pourront pas être conservées ...

Cdt, Hamcec.
 
Dernière édition:
Vote positif 0 Vote négatif
Re : redimensionner image lors d'une insertion automatique dans une cellule fusionnée

Bonsoir job75,

Votre code avait bien entendu été testé.

En me référant au titre du post "redimensionner image lors d'une insertion automatique dans une cellule fusionnée", je voulais simplement indiquer que l'image redimensionnée ne peut recouvrir l'ensemble de la plage fusionnée en conservant ses proportions initiales.

A+.
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Y
  • Résolu(e)
XL 2016 Remplacer du texte par une image dans une application
Réponses
8
Affichages
134
OKBI
O
Jouxte
  • Question Question
XL 2021 coller une image interne au classeur
2 3
Réponses
33
Affichages
1 K
Jouxte
Jouxte
chaelie2015
  • Question Question
XL 2013 ajustement automatique du texte dans une cellule fusionnée
Réponses
7
Affichages
542
Phil69970
Phil69970
L
  • Question Question
Microsoft 365 Macro Insertion image dans cellule
Réponses
3
Affichages
968
Dranreb
Dranreb
jeff1494
  • Question Question
XL 2021 Orientation d'une image dans le commentaire d'une cellule
2 3
Réponses
42
Affichages
2 K
AtTheOne
AtTheOne
Jean Marc DALPHRASE
  • Question Question
XL 2016 Insertion automatique d'une photo dans une cellule
Réponses
5
Affichages
545
Jean Marc DALPHRASE
Jean Marc DALPHRASE
M
  • Résolu(e)
Microsoft 365 Image stockée dans une feuille à l'initialisation du userform
2
Réponses
20
Affichages
2 K
meyscal
M
A
  • Question Question
XL 2016 Adapter une image à une cellule
2
Réponses
16
Affichages
2 K
Dudu2
Dudu2
Nicolas JACQUIN
  • Question Question
XL 2016 Position userform dans coin supérieur gauche de cellule 2016 et+
7 8 9
Réponses
129
Affichages
4 K
Dudu2
Dudu2
Jouxte
  • Question Question
XL 2013 VBA Insérer image dans zone sélectionnée
Réponses
11
Affichages
1 K
patricktoulon
patricktoulon
C
  • Question Question
XL 2021 Comment intégrer le contenu d'une cellule dans une formule
Réponses
1
Affichages
329
chris
chris
Orfelia
  • Question Question
Microsoft 365 Ajuster la largeur des colonnes selon un chiffre inscrit dans une cellule
Réponses
11
Affichages
651
job75
job75
M
  • Question Question
XL 2010 Insérer image dans une zone de texte
2
Réponses
15
Affichages
2 K
patricktoulon
patricktoulon
C
  • Question Question
XL 2019 Insérer plusieurs images dans plusieurs cellules en suivant un ordre précis
2 3
Réponses
30
Affichages
5 K
Staple1600
Staple1600
PHV.FSM
  • Question Question
XL 2016 Calculer la position sur l'écran d'une position sur la grille (XL 2003)
2
Réponses
27
Affichages
3 K
Nicolas JACQUIN
Nicolas JACQUIN
G
  • Question Question
XL 2013 Ajuster la hauteur de ligne d'une cellule dans laquelle je récupère le contenu d'une autre cellule via une formule
Réponses
2
Affichages
715
galland
G
H
  • Question Question
XL 2019 Récupérer une valeur en abscisse et ordonnée d'un tableau en fonction de la valeur dans le tableau, qui elle dépend d'une autre cellule.
Réponses
8
Affichages
2 K
yal
Y
W
  • Résolu(e)
Microsoft 365 Insertion Image dans une Feuille et Ratio conservé
2
Réponses
23
Affichages
3 K
patricktoulon
patricktoulon
C
  • Résolu(e)
XL 2016 Insertion d'une image à l'aide d'une macro dans une cellule fusionner
2
Réponses
17
Affichages
2 K
re4
R
F
  • Question Question
XL 2013 Insertion photo et redimensionner selon taille de la cellule
Réponses
3
Affichages
4 K
patricktoulon
patricktoulon
Retour