Discussion :

[Gado2600]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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,

[EricDgn]

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

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.

[patricktoulon]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
xlWkShape.Left = ((rng.Left + rng.Width) - xlWkShape.Width ) / 2
xlWkShape.TOP= ((rng.TOP+ rng.HEIGHT) - xlWkShape.height) / 2

[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,

[patricktoulon]

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

[patricktoulon]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Gado2600]

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.





Cordialement,

[patricktoulon]

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

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

[patricktoulon]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

si je fais

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

si je fais

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[patricktoulon]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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,

[patricktoulon]

re

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é ?

[patricktoulon]

re
une démo parle mieux que les mots

les boutons dans la feuille

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

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

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

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