Menu

Redimensionner une image dans Excel (VBA) grâce à des cellules [Résolu]

Messages postés
26
Date d'inscription
dimanche 17 septembre 2017
Dernière intervention
28 décembre 2018
- - Dernière réponse : STVNA
Messages postés
26
Date d'inscription
dimanche 17 septembre 2017
Dernière intervention
28 décembre 2018
- 21 déc. 2018 à 12:50
Bonjour à tous !

En 2015, j'ai posté cette question : https://www.commentcamarche.net/forum/affich-31772094-redimensionner-une-image-automatiquement-avec-excel-vba

On aimerait maintenant redimensionner une image dans Excel de cette manière : lorsque l'on met une largeur et une hauteur dans des cellules, une image se redimensionne toute seule en fonction de ces valeurs et donc en utilisant VBA.

Merci d'avance !
Afficher la suite 

Votre réponse

1 réponse

Messages postés
400
Date d'inscription
mardi 5 juin 2018
Dernière intervention
13 février 2019
29
0
Merci
Bonjour,

En supposant qu'il n'y ait qu'une seule image sur la feuille, mets cette macro dans le module de la feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
  If [A1] <> "" And [A2] <> "" And IsNumeric([A1]) And IsNumeric([A2]) Then
    If Target.Address = "$a$1" Or Target.Address = "$a$2" Then
      With ActiveSheet.Pictures(1)
        .Height = [A1]
        .Width = [A2]
      End With
    End If
  End If
End Sub



A1=hauteur
A2= largeur
Avec les valeurs en points.

Cordialement.
danielc0
Messages postés
400
Date d'inscription
mardi 5 juin 2018
Dernière intervention
13 février 2019
29 > STVNA
Messages postés
26
Date d'inscription
dimanche 17 septembre 2017
Dernière intervention
28 décembre 2018
-
Voici le fichier corrigé (j'ai corrigé la formule) :

https://mon-partage.fr/f/nU6DwuPA/

Daniel
STVNA
Messages postés
26
Date d'inscription
dimanche 17 septembre 2017
Dernière intervention
28 décembre 2018
-
D'accord merci beaucoup !
STVNA
Messages postés
26
Date d'inscription
dimanche 17 septembre 2017
Dernière intervention
28 décembre 2018
-
Bonjour,
Merci pour votre aide. Seulement, nous n'avions pas bien compris. Nous voulons deux mesures (une largeur et une hauteur) et que l'on peut modifier soit l'une, soit l'autre, soit les deux et que l'image prend donc ces mesures (donc pas forcément proportionnel). Comme nous l'avons fait au début mais donc avec plusieurs images sur une même page. Et si possible en mm.

Encore un grand merci d'avance et désolé pour tous ces changements !
danielc0
Messages postés
400
Date d'inscription
mardi 5 juin 2018
Dernière intervention
13 février 2019
29 > STVNA
Messages postés
26
Date d'inscription
dimanche 17 septembre 2017
Dernière intervention
28 décembre 2018
-
Bonjour,

Remplace la macro par la suivante :

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column = 1 And IsNumeric(Target) Then
    On Error Resume Next
    Set Var = ActiveSheet.Pictures(Target.Offset(-1).Value)
    If Err.Number = 0 Then
      On Error GoTo 0
      With ActiveSheet.Pictures(Target.Offset(-1).Value)
        .ShapeRange.LockAspectRatio = msoFalse
        .Height = Target.Value / 10 / 2.54 * 72
        .Width = Target.Offset(1).Value / 10 / 2.54 * 72
      End With
    Else
      Err.Clear
      Set Var = ActiveSheet.Pictures(Target.Offset(-2).Value)
      If Err.Number > 0 Then
        Err.Clear
        On Error GoTo 0
        Exit Sub
      End If
      Err.Clear
      On Error GoTo 0
      With ActiveSheet.Pictures(Target.Offset(-2).Value)
        .ShapeRange.LockAspectRatio = msoFalse
        .Height = Target.Offset(-1).Value / 10 / 2.54 * 72
        .Width = Target.Value / 10 / 2.54 * 72
      End With
    End If
  End If
End Sub


La première valeur est la hauteur et la seconde la largeur.

Daniel
STVNA
Messages postés
26
Date d'inscription
dimanche 17 septembre 2017
Dernière intervention
28 décembre 2018
-
Un grand merci ! Tout fonctionne.
Commenter la réponse de danielc0