Déplacement intempestif images Shapes

Le 03/01/2020 à 17:48

Bonjour à tous,

Après avoir parcouru le forum, j'ouvre un post comme beaucoup de novices en utilisation de VBA n'ayant pas trouvé de réponse...

Je travaille sur la création d'un fichier Excel gérant une bibliothèques d'images à venir positionner à tel ou tel emplacement de la feuille en fonction des valeurs renseignées dans différentes cases. Mon fichier était terminé et me donnait entière satisfaction.

Cependant, lorsque j'ouvre le document sur un autre poste, les positions de mes images sont décalées et je perds l'alignement que je cherche à conserver.

Sur les captures ci-dessous, sur la première on observe que mes images sont dans une position donnée (celle du dernier enregistrement sur mon poste).

Sur la deuxième capture, après avoir lancé la macro en cliquant sur le bouton "MàJ Plan", les images ont bougées.

J'ai affiché des bordures sur une ligne et une colonnes. Ces bordures restent fixent et permettent d'observer le décalage.

capture001 capture002

Je ne peux pas poster le fichier en l'état, je l'ai donc simplifié sachant que les lignes de codes utilisées sont tout le temps les mêmes. Malheureusement, j'ai l'impression que le problème n'existe plus dans ce fichier simplifié...

capture003

J'ai repositionné ligne par ligne les différentes positions et cas possibles depuis l'autre poste mais le problème existe encore.

Si quelqu'un à une piste je suis preneur svp.

Merci d'avoir pris le temps de lire mon message.

6r2-tab-04-generateur-schema-de-principe-light.xlsm (51.89 Ko)
Le 03/01/2020 à 18:47

Bonjour,

Pourquoi sélectionner la forme ?

J'aurais plutôt écrit :

'RF
With Feuil1
  If .Cells(6, 18) = "RF" Then
    With .Shapes("RF"): .Left = 340: .Top = 135: End With
    With .Shapes("KF"): .Left = 600: .Top = 1400: End With
    With .Shapes("FF"): .Left = 750: .Top = 1400: End With
    With .Shapes("FxF"): .Left = 900: .Top = 1400: End With
    With .Shapes("KxF"): .Left = 1050: .Top = 1400: End With
  End If
End With
'etc ...
Le 03/01/2020 à 22:23

Merci pour votre réponse.

J'ai utilisé ce code sur les conseils d'un collègue. Je vais réessayé avec votre suggestion la semaine prochaine.

Le 07/01/2020 à 17:53

J'ai passé la journée à retranscrire mon code dans la nouvelle version mais j'ai malheureusement toujours le même problème. Cela aura a minima eu l'avantage de simplifier le code. Merci Patrice33740.

J'ai continué de creuser de mon côté et j'ai constaté sur une image que les valeurs pour Top, Left, Height and Width ne sont pas les mêmes pour le même fichier ouvert sur deux postes différents. (Voir ci-dessous).

Cela viendrait du poste sur lequel est ouvert le document? A terme, ce fichier devra être utilisables par plusieurs collaborateurs sur leur propres machines...

Je m'arrache les cheveux, un idée?

capturetse capturemarvin
Le 07/01/2020 à 23:29

Re,

Je crois qu'il faut tenir compte de la résolution écran.

Le 09/01/2020 à 17:59

Avec l'aide d'un ami, nous avons tenté de prendre en compte la résolution de l'écran de la manière suivante:

  • A partir de l'ordinateur à partir duquel on créé le fichier, on insère une image nommée "1000x1000" pour laquelle on impose initialement Height=600 et Width=600 (arbitrairement).
  • A partir de cette image, dont les dimensions sont sensées varier autant que le décalage qui est créé sur un autre poste, on génère automatiquement des coefficients "scale_x" et "scale_y" qu'on applique aux positions en Left et Top.

Malheureusement, l'essai sur l'ordinateur d'un collègue nous a montré que nous avons toujours le décalage. 

'With Feuil1.Shapes("1000x1000")
'    .Height = 600
'    .Width = 600
'    .Left = 5000
'    .Top = 50
'End With

Dim Height_org As Double
Dim Width_org As Double
Dim scale_x As Double
Dim scale_y As Double

With Feuil1.Shapes("1000x1000")
    Height_org = .Height
    Width_org = .Width
End With

scale_x = WorksheetFunction.Round(Height_org / 600, 10)
scale_y = WorksheetFunction.Round(Width_org / 600, 10)

'TC MANCHON - AA/RF

With Feuil1
  If .Cells(5, 18) = "AA" And .Cells(7, 18) = "MANCHON" And .Cells(6, 18) = "RF" Then
    With .Shapes("RF"): .Left = scale_x * 352: .Top = scale_y * 145: End With
    With .Shapes("KF"): .Left = scale_x * 600: .Top = scale_y * 1400: End With
    With .Shapes("FF"): .Left = scale_x * 750: .Top = scale_y * 1400: End With
    With .Shapes("FxF"): .Left = scale_x * 900: .Top = scale_y * 1400: End With
    With .Shapes("KxF"): .Left = scale_x * 1050: .Top = scale_y * 1400: End With
  End If

End With

...

J'ai commencé à lire des informations sur les Twips et les fonctions Screen.TwipsPerPixel si ça parle à quelqu'un.

Je vais essayer creuser cette piste demain.

Le 09/01/2020 à 22:26

As tu regarder en mettant ton image dans un userform?? ca figerait le cadre de travail. j'avais pris cette option pour visionner des feuilles si besoin je t'enverrai le fichier . Bonne soirée

Le 09/01/2020 à 23:46

Merci pour vos réponses.

As tu regarder en mettant ton image dans un userform?? ca figerait le cadre de travail. j'avais pris cette option pour visionner des feuilles si besoin je t'enverrai le fichier . Bonne soirée

Je suis assez novice mais je ne suis pas sur que cela corresponde à mon besoin. Mes images sont au format png et gèrent des parties en transparence, ce qui me permet de superposer des images et de voir tous les traits.

Est-ce possible avec un userform? Ne vais-je pas avoir également une barre de titre?

Je suis preneur du fichier pour m'aiguiller si cette solution convient.

Le 09/01/2020 à 23:59

Effectivement le pgn n 'est pas supporter par l'userform, donc oublis mon idée

Normalement non tu peux dimentionner ton image en fonction de ton ecran, je maitrise pas vraiment,

Bonne continuation

Le 10/01/2020 à 00:13

je te conseil de lire le chapitre de jacquesboisgontier qui passe d'ailleurs de temps en temps sur le forum http://boisgontierjacques.free.fr/pages_site/lesimages.htm

et ce file egalement peu etre interressant

https://forum.excel-pratique.com/viewtopic.php?t=83741

Le 14/01/2020 à 09:27

Bonjour,

J'ai réussi à m'en sortir avec le code suivant.

Merci pour vos réponses et commentaires qui m'ont permis d'orienter les recherches de solution dans la bonne direction!

Le principe:

- Insérer une image de calibrage dont on défini les dimensions via le code une première fois via le pc sur lequel on créé le fichier.

Sub Nom_Code001_Click()

With Feuil1.Shapes("Nom_image_calibrage")
  .Height = 600
  .Width = 600
  .Left = 5000
  .Top = 50
End With

End Sub

- Désactiver le code ci-dessus pour que les dimensions ne bougent plus.

- A chaque module, préciser ensuite qu'on veut que toutes les images soient redimensionnées par un facteur issu des dimensions de l'image de calibrage précédente.

Sub Nom_Code001_Click()

'With Feuil1.Shapes("Nom_image_calibrage")
'    .Height = 600
'    .Width = 600
'    .Left = 5000
'    .Top = 50
'End With

Dim Height_org As Double
Dim Width_org As Double
Dim scale_x As Double
Dim scale_y As Double

With Feuil1.Shapes("Nom_image_calibrage")
    Height_org = .Height
    Width_org = .Width
End With

scale_x = WorksheetFunction.Round(Width_org / 600, 10)
scale_y = WorksheetFunction.Round(Height_org / 600, 10)

With Feuil1
  If .Cells(7, 18) = "Valeur_cellule_001" And .Cells(31, 18) = "Valeur_cellule_002" And .Cells(12, 18) = "Valeur_cellule_003" Then
    With .Shapes("Nom_image_001"): .Left = scale_x * 358: .Top = scale_y * 289: End With
    With .Shapes("Nom_image_002"): .Left = scale_x * 50: .Top = scale_y * 1300: End With
    With .Shapes("Nom_image_003"): .Left = scale_x * 100: .Top = scale_y * 1300: End With
    With .Shapes("Nom_image_004"): .Left = scale_x * 150: .Top = scale_y * 1300: End With
    With .Shapes("Nom_image_005"): .Left = scale_x * 200: .Top = scale_y * 1300: End With
  End If
End With

...

End Sub
Le 14/01/2020 à 10:01

Parfait !

A bientot sur le forum pour de nouveaux sujets

Rechercher des sujets similaires à "deplacement intempestif images shapes"