XL 2016 VBA Insertion d'une image

danielco · 7 Avril 2020

Bonjour,

J'utilise ce code pour insérer des photos :

VB:

  For Each C In Range("D3", Cells(Rows.Count, 4).End(xlUp))
    Photo = C.Value
    Set Img = ActiveSheet.Pictures.Insert(Chemin & Photo & ".jpg")
    With Img
      .Left = C.Offset(, -2).Left
      .Top = C.Offset(, -2).Top
      .Width = Larg
      If C.Height < .Height Then
        .Height = C.Height
      End If
    End With
  Next C

La ligne :

Code:

 .Left = C.Offset(, -2).Left

devrait aligner la photo sur le bord gauche de la colonne B, or ce n'est pas le cas. Qu'est-ce que j'ai fait de travers ?

Le fenêtre d'exécution donne :

?c.Address
$D$3
?C.Offset(, -2).left
161.25
?img.left
161.25

Merci d'avance.

Daniel

patricktoulon · 9 Avril 2020

re
bon si on considère que toutes tes images pivotées ont la donnéee exif (245)
voila les model ou je prends un raccourci methode en faisant simplement un copypicture de l'image re pivoté sur le sheets pour ne pas avoir a m'ennuyer avec les left et top inversé dans le calcul
model 1 pour faineant de la calbasse

VB:

Private Sub CommandButton1_Click()
    Dim fichier As Variant, img As Picture
    On Error Resume Next
    ActiveSheet.Shapes("img").Delete
    Err.Clear
    fichier = Application.GetOpenFilename("Text Files (*.jpg), *.jpg", 1, "ouvrir un fichier")
    If fichier = False Then Exit Sub
    Set img = ActiveSheet.Pictures.Insert(fichier)
    img.Name = "img"
    place_l_image_dans [C5], img...

patricktoulon · 7 Avril 2020

re
@Modeste geedee

VB:

 If Cellule.Height < .Height Then
        .Height = Cellule.Height
      End If
'----------------------
      .Width = Larg

le width n'est forcement pas bon car en faisant cela tu resize le height aussi que tu a dimensionné précédemment
pour le coup ca marche car les dim image correspondent mais ca ne sera pas toujours le cas

patricktoulon · 7 Avril 2020

re

en lockAspectRatio on ne redimensionne qu'un coté et pour choisir le quel ?:

il n'y a qu'une seule logique
ratioimg =img .Width / img .Height ' calcul ratio image

ratiorange =[cellule].Width / [cellule] .Height ' calcul ratio Range

if ratiorange< ratioimg then

img.width=[cellule].width

else

img.height=[cellule].height

end if
ET AUCUNE AUTRE NE SERA AUSSI SUR
est ce si difficile a comprendre?????

Modeste geedee · 7 Avril 2020

Bonsour®

jmfmarques à dit:
A Modeste geedee : les saluts ne sont pas ma raison de vivre.
J'aurais aimé (mais tel n'a pas été le cas) voir danielco au moins réagir à ceci :
Tout cela est bien dommage, car il aurait été conduit à du plus élégant que ce qu'il a maintenant entre les mains.
Mais bon ...

il ne tenait qu'a toi de proposer "ta" correction concrète du code :

https://www.excel-downloads.com/attachments/fleurentsteve-xlsm.1061582/

au lieu de faire preuve de de prosélytisme ...
Danielco (MVP EXCEL) qui a montré depuis de nombreuses années son sens de l'entraide sur de multiples forums
est comme tout un chacun (lorsque l'on a la tête dans le guidon) passé à coté de l'évidence.

Modeste geedee · 7 Avril 2020

Bonsour®

patricktoulon à dit:
le width n'est forcement pas bon car en faisant cela tu resize le height aussi que tu a dimensionné précédemment
pour le coup ca marche car les dim image correspondent mais ca ne sera pas toujours le cas

je reconnais la justesse de la remarque...
d'aucun parleront d'élégance ???

patricktoulon · 7 Avril 2020

Modeste geedee à dit:
Bonsour®
je reconnais la justesse de la remarque...
d'aucun parleront d'élégance ???

relis le post 32 je ne peux être plus explicite

jmfmarques · 7 Avril 2020

Nous allons dire, Modeste geedee, que nous n'avons pas la même conception de l'aide.
La mienne implique des "choses" autres que du code à recopier.

danielco · 7 Avril 2020

patricktoulon à dit:
bon danielco
prends ce fichier
clique sur le bouton et choisi un jpg avec le dialog
répète l’opération autant de fois que tu veux avec des image et forme différentes
et dit moi encore que ça marche pas

Ca marche pas ;-( :

Daniel

patricktoulon · 7 Avril 2020

tu peux me donner cette image Svp

danielco · 7 Avril 2020

Effectivement, ce n'est pas le code, comme l'explique Modeste, ça vient de l'image.

Daniel

patricktoulon · 7 Avril 2020

re
a ben voila comment elle est chez moi
elle est tout simplement pas dans le bon sens

et une fois redressée avec les flèches de la visionneuses windows

Modeste geedee · 7 Avril 2020

danielco à dit:
Effectivement, ce n'est pas le code, comme l'explique Modeste, ça vient de l'image.

Daniel

exactement ça que subodorait ...

le descripteur de l'image ne tient pas compte de l'orientation

Prise de vue HUAWEI, mais le redressement à eu lieu sur le poste de travail .
le ratio (proportionalité H/L) semble correct

danielco · 7 Avril 2020

Oui c'est bien ce qu'a dit @Modeste geedee , l'image est pivotée. Mon problème reste : j'ai 400 de ces images dont beaucoup sont dans ce cas. Est-il possible de les trouver (et les faire pivoter, ça oui) via VBA ?

Daniel

patricktoulon · 7 Avril 2020

re
donne moi en une autre de ces images en défaut je crois que j'ai une solution mais il faut que je teste
celle ci ayant été redressée c'est fini

par contre avant redressage elle se positionnait couché chez moi dans la feuille pas droite

Modeste geedee · 7 Avril 2020

Bonsour®

patricktoulon à dit:
re
donne moi en une autre de ces images en défaut je crois que j'ai une solution mais il faut que je teste
celle ci ayant été redressée c'est fini

par contre avant redressage elle se positionnait couché chez moi dans la feuille pas droite

si l'info orientation lors de la prise de vue n'est pas dans le EXIF, seul un contrôle visuel pourra te confirmer le cas ...
La configuration portrait ou paysage n'augure en aucune façon la posture du sujet.
on trouve sur le web des lecteurs de données EXIF

pour utilisation via VBA il faut utiliser des librairies spécifiques EXIF
il est même probable que les ressources XLD possèdent déjà un outil de ce type...?

danielco · 8 Avril 2020

patricktoulon à dit:
re
donne moi en une autre de ces images en défaut je crois que j'ai une solution mais il faut que je teste
celle ci ayant été redressée c'est fini

par contre avant redressage elle se positionnait couché chez moi dans la feuille pas droite

Voici :

Daniel

XL 2016 VBA Insertion d'une image

danielco

XLDnaute Accro

patricktoulon

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Modeste geedee

XLDnaute Barbatruc

Modeste geedee

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

jmfmarques

XLDnaute Accro

danielco

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

danielco

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

Modeste geedee

XLDnaute Barbatruc

danielco

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

Modeste geedee

XLDnaute Barbatruc

danielco

XLDnaute Accro

Discussions similaires