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 · 8 Avril 2020

re
bonjour Modeste geedee,danielco
et oui il va te falloir faire un examen dans les données exif la 245 plus exactement
donc voici une petite demo pour se passer de logiciel

VB:

Sub test()
MsgBox GetImg_Orientation("C:\Users\Public\Pictures\Sample Pictures\Desert.jpg")
MsgBox GetImg_Orientation("C:\Users\polux\Downloads\5 minutes histoires pour dormir.jpg")
MsgBox GetImg_Orientation("C:\Users\polux\Downloads\Achille Talon no5.jpg")
End Sub
Function GetImg_Orientation(fichier)
dossier = Mid(fichier, 1, InStrRev(fichier, "\") - 1)
img = Mid(fichier, InStrRev(fichier, "\") + 1)
Set shApp = CreateObject("Shell.Application")
    Set fld = shApp.Namespace(dossier)
    Set Fich = fld.items.Item(img)
  GetImg_Orientation = fld.getdetailsof(Fich, 245)
End Function

apres si je me trompe pas dans ma logique c'est :
si c'est vide on fait rien
si =270 alors la shape doit être retourner de 270
si c'est moins alors la shape doit être retourner de 270 - le résultat

bien sur pour automatiser il faudra supprimer le texte du résultat et ne garder que les chiffre
j'ai retrouver cela au fin fond de mes archives image et vba LOL

jmfmarques · 8 Avril 2020

Re bonjour, danielco
L'orientation donnée aux images par rapport aux sujets est une chose. Et cette chose, à traiter avant utilisation/insertion, n'a rien à voir avec le problème principal qui demeure, pour chaque image "dans le bon sens", avec la proposition de code que tu as marquée comme "solution" alors qu'elle souffre d'une erreur majeure (et je le déplore personnellement car d'aucuns, passant par cette discussion, se "tomberont" du coup en toute bonne foi dans le même piège).
Je te propose donc A NOUVEAU (et ce sera la dernière fois) de te conduire, pas à pas, vers ce qui sera à la fois très simple, infaillible et élégant.
Il ne s'agira en aucun cas de "correction de code", mais de méthode.
A toi de voir ...

patricktoulon · 8 Avril 2020

RE
Bonjour jmfmarques
y a pas que danielco je peut être intéressé moi aussi si je peux me passer de shel.application et/ou WIA je prends

jmfmarques · 8 Avril 2020

Bonjour Patrick
Je ne parle absolument pas du "redressement éventuel" d'images, mais tout simplement de leur traitement en l'état (à savoir l' insertion de l'image, telle qu'elle est, dans le bon sens ou non ). Son redressement éventuel est un tout autre sujet

patricktoulon · 8 Avril 2020

OK si tu a une autre solution que la mienne je veux bien la connaitre
qui sait?, c'est peut être plus simple

danielco · 8 Avril 2020

Merci Patrick. Mais, les photos s'affichent toutes dans le bon sens. Donc, après avoir déterminé si une image pose problème, je pense seulement, qu'il faut utiliser la hauteur comme la largeur et inversement. Je vais partir dans cette direction à partir de ton code.

Daniel

danielco · 8 Avril 2020

jmfmarques à dit:
Re bonjour, danielco
L'orientation donnée aux images par rapport aux sujets est une chose. Et cette chose, à traiter avant utilisation/insertion, n'a rien à voir avec le problème principal qui demeure, pour chaque image "dans le bon sens", avec la proposition de code que tu as marquée comme "solution" alors qu'elle souffre d'une erreur majeure (et je le déplore personnellement car d'aucuns, passant par cette discussion, se "tomberont" du coup en toute bonne foi dans le même piège).
Je te propose donc A NOUVEAU (et ce sera la dernière fois) de te conduire, pas à pas, vers ce qui sera à la fois très simple, infaillible et élégant.
Il ne s'agira en aucun cas de "correction de code", mais de méthode.
A toi de voir ...

Bonjour,

Toute aide est la bienvenue.

Daniel

jmfmarques · 8 Avril 2020

OK si tu a une autre solution que la mienne je veux bien la connaitre
qui sait?, c'est peut être plus simple

1) c'est la fausse solution de Modeste geedee (en plus acceptée comme "solution") que je conteste à grands cris !
2) on y va maintenant , à ce qui convient, mais pas à pas (afin que tous puissent suivre)
---A/ on décide astucieusement de donner à la cellule d'accueil une forme rigoureusement carrée (en unités logiques).
On va dans l'exemple qui va suivre, décider d'insérer une image dans la cellule E19
Comment rendre carrée une cellule ? --->> je l'ai montré très récemment --->> ainsi --->>

VB:

Range("E19").RowHeight = Range("E19").Width

revenez quand fait

patricktoulon · 8 Avril 2020

re
en attendant ta proposition voici une nouvelle écriture de ma méthode

VB:

Sub place_l_image_dans(Rng As Range, Shp As Picture)
    Dim x&
    With Shp
        .ShapeRange.LockAspectRatio = msoTrue    ' met  l'aspect Ratio a true
        x = (Rng.Width / Rng.Height) < (.Width / .Height)'comparaison des ratios
        'en fonction de x et en redimensionnant le width ou le height l'autre se redimensionne automatiquement
        If x Then .Width = Rng.Width Else .Height = Rng.Height
        .Left = Rng.Left    '+ ((Rng.Width - .Width) / 2)'débloquer si l'image doit etre au centre horizontalement
        .Top = Rng.Top    '+ ((Rng.Height - .Height) / 2)'débloquer si l'image doit etre au centre verticalement
        .Placement = 1
    End With
End Sub

jmfmarques · 8 Avril 2020

A partir de l'instant où la cellule d'accueil est carrée (en unités logiques), tout est simple, Patrick.
Regarde :

VB:

Set c = Range("E19")
    Set Img = ActiveSheet.Pictures.Insert("d:\coul.jpg")
    With Img
      .ShapeRange.LockAspectRatio = msoTrue
      Select Case .Width - .Height
        Case Is > 0: .Width = c.Height
        Case Else: .Height = c.Height
      End Select
      .Left = c.Left + (c.Width - .Width) / 2
      .Top = c.Top + (c.Height - .Height) / 2
    End With

patricktoulon · 8 Avril 2020

jmfmarques à dit:
A parti de l'instant où la cellule d'accueil est carrée (en unités logiques), tout est simple, Patrick.
Regarde :

VB:

Set c = Range("E19") Set Img = ActiveSheet.Pictures.Insert("d:\coul.jpg") With Img .ShapeRange.LockAspectRatio = msoTrue Select Case .Width - .Height Case Is > 0: .Width = c.Height Case Else: .Height = c.Height End Select .Left = c.Left + (c.Width - .Width) / 2 .Top = c.Top + (c.Height - .Height) / 2 End With

tu biaise la
on ne sait pas ou on ne doit pas savoir si la range est carré ou rectangle
ce que j'ai donné fonctionne dans toutes les formes (carré/rectangle( et inversement (range/shape)
on lui donne une solution qui va pour tout et toi tu lui donne une solution qui ne va que dans un sens même si en effet ça fonctionne
perso honnêtement et connaissant tes aptitudes, je suis déçu je m'attendais a mieux et je te dis cela en toute sympathie
woah!! là tu me sidère j'ai pas les mots

jmfmarques · 8 Avril 2020

tu biaise la

Je suis loin de "biaiser". Cette mise au carré est la bonne et seule manière d'avoir un rendu équilibré et esthétique entre les articles d'un même document.
je te donne le droit d'être "sidéré", si tu le veux, mais c'est par exemple sur cette base-là que sont "construits" tous les albums de photographie.
Maintenant (et si tu y tiens) rien n'est plus simple (quelques conditions de plus, c'est tout) que de déterminer la plus grande image possible au sein d'un rectangle. C'est juste une perte de temps.

patricktoulon · 8 Avril 2020

re
c'est ton point de vue
perso j'utilise mon principe depuis pas mal d'années et il ne m'a jamais fait défaut
en fait tu propose ce que @danielco avait maladroitement tenté de coder au début il me semble
mais bon je respecte c'est ton point de vue
perso je suis un codeur bio je réutilise a volonté donc une fonction générique quand c'est possible me parait un accessoire plus intelligent mais ça s’arrête a moi

Maintenant (et si tu y tiens) rien n'est plus simple (quelques conditions de plus, c'est tout) que de déterminer la plus grande image possible au sein d'un rectangle

c'est ce que je fait avec ma méthode
je fini le rotation en fonction de la données excif et reviens

jmfmarques · 8 Avril 2020

C'est comme tu veux, Patrick
Mais garde ceci présent à l'esprit la forme carrée d'un conteneur d'accueil est et sera toujours (pour des raisons purement arithmétiques) la solution qui offrira toujours la plus grande image (proportions gardées) possible. Une forme rectangulaire (par exemple Largeur = 2 fois hauteur) réduira par exempl;e à peau de chagrin la taille d'une image deux fois plus haute que large). Voilà tout et voilà pourquoi est fait par les pros le choix d'accueils carrés.
Je crois savoir que c'était également là le choix préféré fait en ce qui concernait les écrans de projection

EDIT : ceci étant, je vais laisser Danielco décider de ce qui lui convient le mieux, après avoir lu et bien "pesé" tout ceci, surtout si son "album" contient des images rectangulaires dans les deux sens (les unes plus hautes que larges et les autres plus larges que hautes). Rien de tel que l'expérience pour bien choisir ...

patricktoulon · 8 Avril 2020

re
je peux concevoir l' arguments (carré pour les pro)pour des raisons de simplicité
mais pour l'argument qui réduirait à peau de chagrin j'invalide!!!
tout bonnement par ce que le résultat sera le même avec un carré ou un rectangle d’accueil identique en terme de hauteur
plus simple oui!!! mieux non!!!
que les choses soient claires;c'est l'image que l'on adapte a la cells pas l'inverse
d'ailleurs sans le vouloir dans la ressource il me semble le démontrer

XL 2016 VBA Insertion d'une image

danielco

XLDnaute Accro

patricktoulon

patricktoulon

XLDnaute Barbatruc

jmfmarques

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

jmfmarques

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

danielco

XLDnaute Accro

danielco

XLDnaute Accro

jmfmarques

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

jmfmarques

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

jmfmarques

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

jmfmarques

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

Discussions similaires