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

 

[jmfmarques]

Dur de la "comprenure", à ce que je vois
Allez, montre moi ce que tu montrerais en affichant ceci
__
! !
! !
! !
!_!
dans cela :
____________________________
!___________________________!
et en en gardant les proportions
bref .......

 

[job75]

Dur de la "comprenure", à ce que je vois

[En passant] bref je note ce genre de remarque et laisse à l'intéressé le soin de réagir.

 

[jmfmarques]

Bonjour Job75
je suis quant à moi plus simple : j'attends le résultat d'une telle insertion. le reste est perte de temps.

 

[danielco]

Perso, je choisis l'option "sans floodeur".

Daniel

 

[patricktoulon]

re
jmfmarques là encore tu biaise l'orientation de ton raisonnement
relis ma réponse surtout le passage ou je parle d'un rectangle de même hauteur!!!!! que le carré et non les dimensions inversées

donc voila l'exemple avec rotation (a condition que la donnée excif soit présente bien sur!!)
reste a faire l'inversion logique (.height=rng.height/.height=rng.width)et vice et versa en fonction de rot

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")
    rot = GetImg_Orientation(fichier)
    MsgBox rot
    If fichier = False Then Exit Sub
    Set img = ActiveSheet.Pictures.Insert(fichier)
    img.Name = "img"

    place_l_image_dans [C5], img, Val(rot)



End Sub
Sub place_l_image_dans(Rng As Range, Shp As Picture, Optional rot As Long = 0)
    Dim x As Boolean
    With Shp
        .ShapeRange.LockAspectRatio = msoTrue    ' met  l'aspect Ratio a true
        x = (Rng.Width / Rng.Height) < (.Width / .Height)
         .ShapeRange.Rotation = rot
        '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
             'ci dessous ne fonctionne pas
             'If x Then .Width = IIf(rot < 0, Rng.Height, Rng.Width) Else .Height = IIf(rot < 0, Rng.Width, 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 As Object, Fich As Object
    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]

re
jmfmarques là encore tu biaise l'orientation de ton raisonnement
relis ma réponse surtout le passage ou je parle d'un rectangle de même hauteur!!!!! que le carré et non les dimensions inversées

donc voila l'exemple avec rotation (a condition que la donnée excif soit présente bien sur!!)
reste a faire l'inversion logique (.height=rng.height/.height=rng.width)et vice et versa en fonction de rot

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")
    rot = GetImg_Orientation(fichier)
    MsgBox rot
    If fichier = False Then Exit Sub
    Set img = ActiveSheet.Pictures.Insert(fichier)
    img.Name = "img"

    place_l_image_dans [C5], img, Val(rot)



End Sub
Sub place_l_image_dans(Rng As Range, Shp As Picture, Optional rot As Long = 0)
    Dim x As Boolean
    With Shp
        .ShapeRange.LockAspectRatio = msoTrue    ' met  l'aspect Ratio a true
        x = (Rng.Width / Rng.Height) < (.Width / .Height)
         .ShapeRange.Rotation = rot
        '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
             'ci dessous ne fonctionne pas
             'If x Then .Width = IIf(rot < 0, Rng.Height, Rng.Width) Else .Height = IIf(rot < 0, Rng.Width, 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 As Object, Fich As Object
    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

Merci Patrick,

Mais... sans rotation ? Parce que là, l'image est pivotée...

Daniel

 

[Modeste geedee]

1) c'est la fausse solution de Modeste geedee (en plus acceptée comme "solution") que je conteste à grands cris !

en fait dans le code de @danielco, il y avait 2 problémes :
1 - une mauvaise approche dimensionnelle :
- positionnement avant que de régler les dimensions
- application des modifications largeur et hauteur sans avoir clairement identifié réellement les cibles respectives
2 -utilisation d'images auxquelles auraient été appliqué des manipulations préalables.

le point 1 avait me semble-t-il été relevé par les divers participants...

il aura cependant fallu 22 posts #22 avant qu'une proposition aille dans le sens de l'attente du demandeur.
cette "fausse solution" pas très académique il est vrai, avait me semble-t-il une visée à l'apaisement.

l'identification du point 2 permettant à @danielco de comprendre et sortir de cet imbroglio. #42

Mais ce besoin d'avoir le dernier mot m'indispose et je ne pense pas etre le seul.
d'autant que la dénégation du point 2 découle d'un manque d'ouverture.. (d'esprit ???)


nb : votre proposition :

 

[patricktoulon]

bon perso j'ai réglé le problème du sens de l'image reste juste a recalculer le left et top

 

[patricktoulon]

c'est bon pour moi j'ai le redim auto , le rotation calculé auto , le positionnement auto
j'ai pris un raccourci
démo

 

[patricktoulon]

re
Bonjour
Bon alors Danielco a tu résolu ton soucis d'image dans le mauvais sens ?

 

[danielco]

Bonjour,

Pas eu le temps de regarder, hier. Je le ferai aujourd'hui, si possible (bizarrement, avec le confinement, j'ai moins de temps disponible). Je reviens après avoir cherché.

Daniel

 

[patricktoulon]

re
j'en ai 2 de solutions

 

[Staple1600]

Bonjour le fil

re
j'en ai 2 de solutions

Et qu'attends-tu pour les poster dans ce cas?
Que cela profite à toute la communauté des XLDiens, non ?

 

[patricktoulon]

Bonjour Staple1600
juste de voir si d'autres ont une meilleure solution

 

[Staple1600]

Bonjour patricktoulon

Euh, je disais cela parce que vous en êtes déjà à 4 pages, les gars !
Pour insérer une image dans un tableur ...(qui comme chacun sait est sa vocation première )|/ISPOILER]

PS: la présence d'émoticones dans ce message signale que ...celui-ci est rédigé dans un registre d'humour bon enfant de confinement