Repositionnement d'images en VBA

Version imprimable

20/05/2019, 14h05
Gado2600

Repositionnement d'images en VBA

Bonjour,

J'ai déjà posé un post sur ce sujet samedi mais je n'arrive pas à remettre la main dessus...

En gros, depuis quelques jours, on rencontre un problème pour repositionner des images insérées en VBA, dans Excel.
Celles-ci sont repositionnées en fonction d'une plage fusionnée. Or, une fois sur deux, elles sont replacées trop à gauche.

On utilise ce genre d'algorithme :

Code:

xlWkShape.Left = rng.Left + rng.Width / 2 - xlWkShape.Width / 2

Cet exemple vient d'un fichier vieux de 2-3 ans sur lequel cela fonctionnait parfaitement jusque là mais depuis quelques jours, c'est aléatoire sur le .left.

On a vérifié les variables et tout semble ok.

Quelqu'un rencontre ce type de problème en ce moment ?

Je ne peux fournir les fichiers sur lesquels on rencontre ce cas, pour des raisons professionnelles...

Cordialement,
20/05/2019, 15h36
EricDgn

Bon, une réponse, assez étonnante, tirée de cette discussion:

Citation:

I finally was able to pinpoint the problem starting at column C. After numerous tests without success, I finally changed the column B width by a small increment and the problem was solved.

Cordialement.
20/05/2019, 15h47
patricktoulon

re
re
bonjour
reste a savoir si ta tes shapes son plus petite que la RNG (qui je suppose est un range)!!!!!!!!!!
Code:

1 2 xlWkShape.Left = ((rng.Left + rng.Width) - xlWkShape.Width ) / 2 xlWkShape.TOP= ((rng.TOP+ rng.HEIGHT) - xlWkShape.height) / 2
;)
21/05/2019, 08h35
Gado2600

Bonjour,

EricDgn, si j'ai bien compris ce qu'il a fait, c'est juste agrandir la colonne précédente pour avoir un mauvais alignement correct. C'est un peu bancal comme solution et on l'a appliqué sur l'un des fichiers concernés mais je n'aime pas vraiment ça.

PatrickToulon, Oui, c'est une range et les shapes sont redimensionnées préalablement pour ne pas dépasser la range en question mais même si elles dépassaient la range en question, il n'y a que la position Left qui pose problème.

Cordialement,
21/05/2019, 14h10
patricktoulon

re

Citation:

PatrickToulon, Oui, c'est une range et les shapes sont redimensionnées préalablement pour ne pas dépasser la range en question mais même si elles dépassaient la range en question, il n'y a que la position Left qui pose problème.

bonjour
relis toi
comment veux tu centrer une image dans un range si elle dépasse la taille du range ou si elle fait la même taille !!!?????
c'est le serpent qui se mort la queue la ;)

si tu veux la centrer il faut que la taille de l'image soit plus petite obligatoirement
si elle mesure la taille du range tu n'a pas de calcul a faire, juste la mettre en left et top de ton range

alors des grande des petite ??????
ok
ton calcul devra se faire comme suit
déterminer le coté le plus grand de l'image(largeur ou hauteur)
diviser son homologue (du range) par le coté déterminé on obtient le coeff range/ image

tu divise donc les width et height de ton image par ce coeff(normalement quand tu en fait un l'autre suit)
tu enlève encore au moins 2 point au 2 dimensions de ton image

une fois cela fait tu peux calculer le left
L=(withRange-widthimage)/2
T=(heightRange-heightimage)/2

on place avec L et T
monimage.top=T
monimage.left=L

elle gardera son ratio et elle sera centrée horizontalement et verticalement
;)

1 pièce(s) jointe(s)

re
démo complète
que l'image soit plus grande ou plus petite elle sera redimensionnée et centrer dans la plage en rouge
code du bouton

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
 
'redim et centre une image au niveau d' un range
'quelle soit plus grande ou plus peite elle se redimantionnera et se centrera dans la plage rouge("b17:c26")
Private Sub CommandButton1_Click()
    Dim plage As Range, monimage As Picture, coeff As Double, L As Double, T As Double, mess As String
    Set plage = Range("b17:c26")
    Set monimage = ActiveSheet.Pictures("Image1")
    If monimage.Width > plage.Width Or monimage.Height > plage.Height Then
        If monimage.Width > monimage.Height Then
            coeff = monimage.Width / plage.Width
        Else
            coeff = monimage.Height / plage.Height
        End If
        monimage.Width = (monimage.Width / coeff) - 4    '(4 ou combien tu veux ici)
        mess = " elle est plus grande"
    Else
        If monimage.Width > monimage.Height Then
            coeff = plage.Width / monimage.Width
        Else
            coeff = plage.Height / monimage.Height
        End If
        monimage.Width = (monimage.Width * coeff) - 4    '(4 ou combien tu veux ici)
        mess = " elle est plus petite"
    End If
    L = (plage.Width - monimage.Width) / 2
    T = (plage.Height - monimage.Height) / 2
    monimage.Left = plage.Left + L
    monimage.Top = plage.Top + T
    DoEvents
    MsgBox mess
 
End Sub

Pièce jointe 476866

21/05/2019, 15h00
Gado2600

2 pièce(s) jointe(s)

Hello !

Je pense que tu as lu trop vite ce que j'ai écris jusque là.

Le problème ne vient pas de ma dimension de l'image versus la range. Je sais fort bien comment faire les produits en croix pour ça. La taille de mon image est, pour moi sur le problème que je rencontre, un détail maîtrisé et on s'éloigne du sujet qui m'intéresse.

J'ai différents algorithmes en place (sur différents fichiers Excel) qui me permettent d'intégrer des images dans Excel, les redimensionner selon une range fusionnée et les replacer selon cette dite, range.
La redimension se passe très bien (tous les cas sont prévus) et le positionnement TOP se passe parfaitement aussi.

Dans mon cas actuel, j'ai un fichier sur lequel l'algorithme pour repositionner en LEFT fonctionnait très bien ces dernières années.
Dernièrement, en reprenant ce même fichier et sans toucher à l'algorithme, le repositionnement LEFT est trop décalé sur la gauche par rapport à la range, 50% du temps.
En contrôlant les valeurs, en pas-à-pas, tout semble nickel.

L'article d'EricDgn me semble similaire au problème que je rencontre mais je ne suis pas très fan de la solution proposée pour contourner le problème.

Pièce jointe 476874

Pièce jointe 476877

Cordialement,
21/05/2019, 15h11
patricktoulon

re

re
c'est plutôt toi qui lis en diagonale ;)
essaie le mien tu verra tu n'aura pas de problème de left
si ton algo flanche de temps en temps c'est qu'il est pas bon dans le sens ou soit tu mouline et ta mémoire sature soit ton calcul est basé avec certainement une donnée en dur (hardcoding) ce qui fait que ca match pas tout le temps
l'algo que je t'ai donné se fou royalement de la taille de l'image(petite , grande, rectangle , carré) il opère selon l'algo que je t'ai détaillé 2 post plus haut
21/05/2019, 16h29
Gado2600

Nope. L'algo ne semble pas rencontré de problèmes à cette étape là, en soit.

Par contre, je me suis posé la question par rapport à la mémoire qui sature et changé la méthode d'insertion sur l'un des projets (en remplaçant LoadPicture par Pictures.Insert) et en virant un contrôle ActiveX qui trainait. Cela semble mieux fonctionner.

Cependant, l'autre projet reste un problème mais on n'arrive pas à trouver ce qui pourrait en être la potentielle cause.

Bref, c'est casse-pied.
21/05/2019, 17h21
patricktoulon

re
je viens de faire quelques expériences justement en variabilisant en double et/ou en long les opérateurs en externalisant le tout dans une fonction
et bien en effet on a des résultats surprenants pour ne pas dire complètement absurde

par exemple si je fais

Code:

object.width-20 'j'ai le bon résultat

si je fais
Code:

1 2 dim W as long w=object.width-20 'j'ai un résultat pas tout a fait bon
si je fais
Code:

1 2 dim W as double w=object.width-20 'j'ai un résultat complément absurde
et en plus si je transporte la variable "W" de la fonction à la sub d'appel j'ai un résultat encore différent et absurde

une qui fonctionne a tout les coup dans tout les cas de figure

re
une qui fonctionne a tout les coup dans tout les cas de figure

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub test()
    Set plage = Range("b17:c26")
    Set monimage = ActiveSheet.Pictures("aaa")
    With monimage
        .ShapeRange.LockAspectRatio = msoTrue    ' lock leratio indéformable
        ratio = .Width / .Height     ' calcul ratio
        w = plage.Width       ' width  range
        h = plage.Height      ' height range
        If (w / h < ratio) Then
            .Width = w - 2
        Else
            .Height = h - (2 / ratio)
        End If
        .Left = plage.Left + ((plage.Width - .Width) / 2)
        .Top = plage.Top + ((plage.Height - .Height) / 2)
        '.Placement = 1
    End With
End Sub

22/05/2019, 09h03
Gado2600

Bonjour,

C'est normal que les résultats puissent paraître absurdes étant donné que si tu passes par un long (ou même un integer), VBA ajustera automatiquement (en arrondissant) le Width, Height, Top ou Left, qui est une donnée de type double, à la base.

Le sujet a totalement dérivé de ma question initiale étant donné que ce n'est pas un problème d'algorithme. Quelle que soit la version de l'algorithme proposée, le problème que je rencontre ne vient absolument pas de là...
C'est plus un problème ressemblant au poste qu'EricDgn m'a linké et je l'en remercie car ça m'a permis de voir que ce n'est pas un problème qui existe depuis peu.

Comme mentionné hier, j'ai retiré un contrôle ActiveX sur l'un des fichiers où ce problème est rencontré et ça l'a corrigé.
Pour le second fichier, on cherche encore.

Cordialement,
22/05/2019, 09h14
patricktoulon

re

re

Citation:

C'est normal que les résultats puissent paraître absurdes étant donné que si tu passes par un long (ou même un integer), VBA ajustera automatiquement (en arrondissant) le Width, Height, Top ou Left, qui est une donnée de type double, à la base.

non tu m'a pas compris j'ai essayé en long,double integer et en variable c'est le long qui est le plus proche

ton sujet c'est bien le left non ?
donc pour calculer son left il faut bien calculer son width non?
et pour calculer son width il faut ajuster l'image a la plage non?
et pour ajuster l'image il faut connaitre le ratio range/image non?
etc....
la dernière que je t'ai donné fonctionne en toutes circonstances j'ai testé avec des ratio différents(l'un carré l'autre rectangle et vice et versa) ,opposés,plus grand,plus petit,etc....
on s'en est pas écarté du tout au contraire j'e met en évidence toute les actions qu'il faut faire pour arriver a ce but
a tu essayé au moins ce que je t'ai donné ?

1 pièce(s) jointe(s)

re
une démo parle mieux que les mots

les boutons dans la feuille

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Private Sub CommandButton1_Click()
Dim plage As Range
Set plage = Range("B4:C14")
place_l_image_dans plage, ActiveSheet.Pictures("pinguouins")
End Sub
Private Sub CommandButton2_Click()
Dim plage As Range
Set plage = Range("f3:h9")
place_l_image_dans plage, ActiveSheet.Pictures("pinguouins")
End Sub
Private Sub CommandButton3_Click()
Dim plage As Range
Set plage = Range("f13:f19")
place_l_image_dans plage, ActiveSheet.Pictures("pinguouins")
End Sub
Private Sub CommandButton4_Click()
Dim plage As Range
Set plage = Range("h13:i20")
place_l_image_dans plage, ActiveSheet.Pictures("pinguouins")
End Sub

la sub ultra simple

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
 
Sub place_l_image_dans(rng As Range, Shp As Picture)
      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 - 2
        Else
            .Height = h - (2 / ratio)
        End If
        .Left = rng.Left + ((rng.Width - .Width) / 2)
        .Top = rng.Top + ((rng.Height - .Height) / 2)
        .Placement = 1
    End With
End Sub

Pièce jointe 477103

si tu a pas ce résultat la c'est que ton algo n'est pas bon ;)

22/05/2019, 11h05
Arkham46

Bonjour,

Est-ce possible de reproduire le problème avec un cas simple ?
Un nouveau fichier Excel.
Une image.
Un code tout simple qui positionne l'image.
Si le bug se produit, joindre le fichier pour qu'on teste.
Cela permettra de voir si c'est dû au fichier ou à la config du poste.
22/05/2019, 23h11
EricDgn

Oui, c'est tout à fait bancal, mais comme indiqué dans la discussion originale, il semble que cela soit un petit bug dans Excel et que le simple fait de modifier la largeur de la colonne remédie à la situation. La modification de la largeur n'a pas été faite pour la mettre à la bonne place par rapport à l'image, mais le simple fait de faire cette modification de largeur de colonne, les choses se font correctement. Ok, c'est bizarre.
Cordialement.