XL 2016 VBA Insertion d'une image

[danielco]

Bonjour,

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

  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 :

 .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

 

[danielco]

Je patauge toujours autant. Je déclare forfait.

Daniel

 

[jmfmarques]

Je patauge toujours autant. Je déclare forfait.

Daniel

Tu pataugeras moins, ami, lorsque tu sauras mettre dans deux paniers différents :
1) la mise dans le bon sens d'images à traiter
et
2) l'insertion, toutes proportions gardées, d'une image, telle qu'elle est, dans le rectangle d'une cellule

ne pas sérier contribue d'une manière générale, sinon à l'égarement, tout au moins au traitement d'un problème autre que le principal (celui exposé).

 

[patricktoulon]

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

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, Val(GetImg_Orientation(fichier))
End Sub
Sub place_l_image_dans(Rng As Range, Shp As Picture, Optional rot As Long = 0)
    Dim x As Boolean
    Application.ScreenUpdating = False
    With Shp
        .ShapeRange.LockAspectRatio = msoTrue    ' met  l'aspect Ratio a true
        Shp.ShapeRange.Rotation = rot: .CopyPicture: ActiveSheet.Paste: .Delete
    End With
    With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
        x = (Rng.Width / Rng.Height) < (.Width / .Height)
        .Name = "img"
        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
Function GetImg_Orientation(fichier) As Long
    Dim Dossier, img, Fld, Fich
    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 = -Val(Replace(Replace(Fld.getdetailsof(Fich, 245), "Pivoter de ", ""), " degrés", ""))
End Function

model 2 pour les moins fainéants de la calbasse

Private Sub CommandButton2_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_dans2 [C5], img, Val(GetImg_Orientation(fichier))
End Sub

Sub place_l_image_dans2(Rng As Range, Shp As Picture, Optional rot As Long = 0)
    Dim x As Boolean, leftmoins&, topmoins&
    Application.ScreenUpdating = False
    With Shp
        .ShapeRange.LockAspectRatio = msoTrue    ' met  l'aspect Ratio a true
         If rot = 0 Then
            If Shp.Height > Rng.Height Then Shp.Height = Rng.Height
            If Shp.Width > Rng.Width Then Shp.Width = Rng.Width
         Else
           Shp.ShapeRange.Rotation = rot:
        If Shp.Width > Rng.Height Then Shp.Width = Rng.Height
        If Shp.Height > Rng.Width Then Shp.Height = Rng.Width
       leftmoins = Abs(.Width - .Height) / 2
       topmoins = Abs(.Height - .Width) / 2
       End If
  .Left = (Rng.Left - leftmoins)
  .Top = (Rng.Top + topmoins)
 End With
End Sub
Private Function GetImg_Orientation(fichier) As Long
    Dim Dossier, img, Fld, Fich
    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 = -Val(Replace(Replace(Fld.getdetailsof(Fich, 245), "Pivoter de ", ""), " degrés", ""))
End Function

 

[danielco]

J'ai essayé les deux méthodes :
1.

2.

J'abandonne.

Daniel

 

[patricktoulon]

perso j'ai essayé sur pc w7 64 office 2013 32 et pc portable W10 64 office 2016 32

 

[danielco]

J'ai la même config que ton portable. Le bizarre, Patrick, c'est que sur ta dernière animation, le msgbox indique "-270" alors que l'affichage est vide, ici, le msgbox est vide...
Merci à toi et à @Modeste geedee .

Daniel

 

[Staple1600]

Re

Sinon il y a cette solution.
Elle n'a juste pas le gout de l'original

OK je sors

 

[danielco]

Un prix libellé en francs... Pourvu que ce soit pas le futur !

 

[patricktoulon]

si le msgbox est vide ca veux dire que la donnée exif n'y est pas et la on peut rien faire
si j'ai -270 ou -180 ou -90 ca veux dire que j'avais la même chose en positif dans les données exif

Alors oui il est possible d'avoir une donnée exif alors que l'image n'est pas pivotée
tout simplement parce qu'elle a été retouchée avec un logiciel de M....
comme par exemple la visionneuse W7 qui permet de pivoter et sauve l'image mais ne change pas la donnée exif (la bonne blague ) LOL

 

[danielco]

Merci encore Patrick.

 

[Modeste geedee]

les métadonnées Exif ne sont pas une norme officielle!!!
elles sont inscrites lors de la prise de de vue numérique. (selon le bon vouloir du fabriquant)
et ne concernent que quelques types de format
il existe des logiciels "tiers" qui permettent de créer, modifier ou effacer les données Exif

Concernant le problème initial , les dimensionnement et centrage ne sont pas compliqués en utilisant un contenant image OCX selon paramètres Clip, zoom ou stretch
Hélas pas de pivotement possible.

 

[patricktoulon]

re
@Modeste geedee
tu a testé mes deux version ?

 

[Modeste geedee]

Bonsour®

re
@Modeste geedee
tu a testé mes deux version ?

cela ne me pose aucun problème...
encore faut-il que la balise Orientation existe et soit renseignée,
car il y a 8 possibles orientations différentes selon orientation, symetrie ou miroir
Ce lien n'existe plus