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]

Il me reste à comprendre pourquoi la 3e image ne se dimensionne pas comme la cellule...

Daniel

 

[patricktoulon]

re
heu ben c'est pas peine d'avoir tenté de te l'expliquer
a tu pris la peine d'aller voir le lien

'sub de placement et centrage de l'image  dans la range en parametre tout en respectant son  ratio
Sub place_l_image_dans(Rng As Range, Shp As Picture, Optional space = 0)
    Dim ratio#, W#, H#
    With Shp
        .ShapeRange.LockAspectRatio = msoTrue    ' lock leratio indéformable
        ratio = .Width / .Height     ' calcul ratio
        W = Rng.Width       ' width  range
        H = Rng.Height      ' height range
        If (W / H < ratio) Then
            .Width = W - space    'en redimentionant le width le height se redimentionne automatiquement
        Else    'ou
            .Height = H - (space / ratio)    'en redimentionant le height le width se redimentionne automatiquement
        End If
        .Left = Rng.Left + ((Rng.Width - .Width) / 2) ' te reste plus qu'a adapter dette ligne  a ce que tu souhaite
        .Top = Rng.Top + ((Rng.Height - .Height) / 2)
        .Placement = 1
    End With
End Sub

 

[danielco]

C'est avec ton code que j'obtiens ce résultat (comme avec le mien). Le problème initial reste entier. Je me demande si ce n'est pas une question de taille de fichier jpg...

Daniel

 

[danielco]

Personne ? Le gourou ou le scieur de tables basses ? C'est plus un jeu de quilles qu'un forum d'entraide.

Daniel

 

[jmfmarques]

Le scieur de tables basses répond présent, mais uniquement à certaines conditions. La première d'entre elles est que tu ne te contentes pas de dire que tu ne comprends pas pourquoi ton mécanisme est boiteux. Ou tu veux de l'aide et je te parlerai alors d'un mécanisme ad hoc, ou tu insistes à vouloir modifier ton mécanisme et tu le feras alors sans moi.

 

[patricktoulon]

re
C'est avec ton code que j'obtiens ce résultat (comme avec le mien). Le problème initial reste entier. Je me demande si ce n'est pas une question de taille de fichier jpg...

'sub de placement et centrage de l'image  dans la range en parametre tout en respectant son  ratio
Sub place_l_image_dans(Rng As Range, Shp As Picture, Optional space = 0)
    Dim ratio#, W#, H#
    With Shp
        .ShapeRange.LockAspectRatio = msoTrue    ' lock leratio indéformable
        ratio = .Width / .Height     ' calcul ratio
        W = Rng.Width       ' width  range
        H = Rng.Height      ' height range
        If (W / H < ratio) Then
            .Width = W - space    'en redimentionant le width le height se redimentionne automatiquement
        Else    'ou
            .Height = H - (space / ratio)    'en redimentionant le height le width se redimentionne automatiquement
        End If
        .Left = Rng.Left + ((Rng.Width - .Width) / 2) ' te reste plus qu'a adapter dette ligne  a ce que tu souhaite
        .Top = Rng.Top + ((Rng.Height - .Height) / 2)
        .Placement = 1
    End With
End Sub

c'est tout bonnement impossible ça a été testé re testé dans toute taille et configuration possible c'est toi qui fait une erreur quelque part

 

[Modeste geedee]

Bonsour®

Personne ? Le gourou ou le scieur de tables basses ? C'est plus un jeu de quilles qu'un forum d'entraide.
Daniel

est loin de la bonne humeur de feu MPFE ...
voir comme ceci :
!!!!!!!!!!!!!!!!!!!
d'abord s'assurer de l'orientation correcte des photos (notament si issues du monde Apple
!!!!!!!!!!!!!!!!!!!

Sub Import()
  Dim Cellule As Range, Chemin As String, Photo As String, Img As Picture, Larg As Double
'********************************************
'------[B1].width renvoie une largeur en caractères de la police du style par défaut !!!!!
'*********************************************
  Larg = [C1].Left - [B1].Left
  Chemin = "E:\Users\Fleurent\Desktop\LIVRE\"

  With ActiveSheet
    For i = .Shapes.Count To 1 Step -1
      .Shapes(i).Delete
    Next i
  End With
  For Each Cellule In Range("D3", Cells(Rows.Count, 4).End(xlUp))
    Photo = Cellule.Value
    Set Img = ActiveSheet.Pictures.Insert(Chemin & Photo & ".jpg")
'*****************************************
'------ il faut modifier les options de ratio avant de toucher aux dimensions !!!
'******************************************
    With Img
        .ShapeRange.LockAspectRatio = msoTrue
'--------------------------
       If Cellule.Height < .Height Then
        .Height = Cellule.Height
      End If
'----------------------
      .Width = Larg
'---------------------
      .Left = [D3].Left
      .Top = Cellule.Top  
    End With
    DoEvents
Next Cellule
End Sub

 

[danielco]

@jmfmarques

Ou tu veux de l'aide et je te parlerai alors d'un mécanisme ad hoc

Ah je croyais être sur un forum d'entraide ? Mais, merci, j'ai la solution, et mon code "boiteux" fonctionne. le problème vient d'un fichier photo curieusement bricolé, merci Modeste. Mais parle-moi d'un "mécanisme ad hoc", @jmfmarques , j'ai envie de voir.

@Modeste geedee :

Ton code fonctionne bien, merci (et sans Merise, encore !) et désolé pour l'humeur, c'est la première fois que j'ai eu l'impression de perdre mon temps, sur ce forum.

Daniel

 

[patricktoulon]

bonsoir Modeste geedee
le lockaspectratio est a true par défaut pas besoins d'y toucher sur MAC je sais pas

 

[jmfmarques]

Bien, danielco, bien. par ton dernier message :
1) tu confirmes ta volonté de n'accepter que ce qui collerait à ton mécanisme
2) tu fermes définitivement la porte au "scieur de tables basses".
Bonne continuation, donc.

 

[Modeste geedee]

Bonsour®

bonsoir Modeste geedee
le lockaspectratio est a true par défaut pas besoins d'y toucher sur MAC je sais pas

l'éclairage m'est venu lorsque j'ai constaté que les images étaient pivotées
les images que j'ai utilisées venaient en effet d'un MAC

 

[patricktoulon]

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

 

[jmfmarques]

et sans Merise, encore !

wow ...! je me demande bien ce que viendrait faire Merise là-dedans ... Ni de près, ni de très loin !
Bref ...

 

[Modeste geedee]

Bonsour®

Bien, danielco, bien. par ton dernier message :
1) tu confirmes ta volonté de n'accepter que ce qui collerait à ton mécanisme
2) tu fermes définitivement la porte au "scieur de tables basses".
Bonne continuation, donc.

Votre participation s'assimile à du "FLAMING"
Le TROLL n'est pas loin !!!
Je ne vous salue pas ...

 

[jmfmarques]

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 :

tu la mets à gauche de la B - la largeur de la A, non ?

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 ...