centraliser un shapes en plein écran

[La Vouivre]

Bonsoir amis du forum
je cherche comment centraliser un shapes sur mon écran ,je m'explique ,j'ai un grand plan avec des shapes et je voudrais que lorsque je sélectionne par un bouton le shapes que celui-ci se retrouve centraliser sur l'écran . les boutons sont sur un Userform ,car j'ai environ 500 points à marquer avec un shapes.
Pour le faire j'utilise les ascenseurs , mais je voudrais que ce soit automatique , je trouve du code pour centraliser sur une cellule ou une page ,mais pas pour recentrer l'image "le plan" sur l'écran
J'ai retirer le plan car trop volumineux , mais le principe c'est de centraliser le shape sur l'écran en non sur la feuille

 

[PMO2]

Re : centraliser un shapes en plein écran

Bonjour,

Dans la mesure où j'ai compris, essayez le code suivant qui se rapporte au bouton "Boulangerie"

Private Sub CommandButton3_Click()    'Boulangerie
Dim SH As Shape
Dim R As Range
'---
Set SH = ActiveSheet.Shapes("Légende encadrée 1 6")
SH.Visible = True
Set R = SH.TopLeftCell
With ActiveWindow
  .ScrollRow = R.Row
  .ScrollColumn = R.Column
End With
End Sub

 

[La Vouivre]

Re : centraliser un shapes en plein écran

Bonsoir PMO2
merci de vous intéresser à mon projet , c'est presque mon souhait ,je voudrais si possible que le shape s'affiche au centre de l'écran ,et la c'est dans le coin supérieur gauche .
Je ne sais pas modifier le code pour obtenir le résultat voulu .Je pense que c'est le code
.ScrollRow = R.Row
.ScrollColumn = R.Column
qu'il faudrait adapter ,mais je n'en sis pas sur ,de plus je suis pas tres fort en VBA , et bien incapable de modifier le code .
Pourriez-vous le modifier SVP et me le commenter ?
par avance merci

 

[PMO2]

Re : centraliser un shapes en plein écran

J'ai supprimé ce message car le code donné ne correspondait pas à la demande.
Il déplaçait les Shapes au lieu de déplacer la fenêtre.
(voir ci-dessous un code allant dans le bon sens).

 

[La Vouivre]

Re : centraliser un shapes en plein écran

merci pour votre investissement , le shape et bien au centre de la feuille ,mais plus en place sur le plan , comment lier le shape au plan pour obtenir la bonne information?

 

[La Vouivre]

Re : centraliser un shapes en plein écran

avec ce réglage le shape ne bouge plus , mais se retrouve en haut à gauge et plus au centre

Private Sub CommandButton1_Click()
'''''''''''''''''''''''''''essais
Dim SH As Shape
Dim R As Range
Dim R2 As Range
Dim i&
'---
Set SH = ActiveSheet.Shapes("Pentagone 1")
SH.Visible = True
Set R = SH.TopLeftCell
With ActiveWindow
.ScrollRow = R.Row
.ScrollColumn = R.Column
Set R = .VisibleRange
End With
'---
Set R2 = R.Cells(1, 1)
For i& = 1 To (R.Rows.Count / 11) - 5
Set R2 = R2.Offset(1, 0)
Next i&
For i& = 1 To (R.Columns.Count / 2) - 9
Set R2 = R2.Offset(0, 1)
Next i&
'---
SH.Top = R2.Top
SH.Left = R2.Left
End Sub

 

[laetitia90]

Re : centraliser un shapes en plein écran

bonsoir tous

peut être dans ce genre

Set SH = ActiveSheet.Shapes("Légende encadrée 1 9")
   SH.Visible = True
    SH.Top = ActiveWindow.Height / 2 - (SH.Height * 2)
   SH.Left = ActiveWindow.Width / 2

 

[La Vouivre]

Re : centraliser un shapes en plein écran

Merci de m'aider Laetitia90 le code s'amméliore ,mais j'ai toujours un décalage entre le shape et l'emplacement d'origine du chape je remet un fichier de démo avec un shape positionner sur la cellule P43

 

[La Vouivre]

Re : centraliser un shapes en plein écran

j'essaie de modifier le code ,mais j'ai pas un tres bon résultat ,en modifiant les lignes
SH.Top = ActiveWindow.Height / 1 - (SH.Height * 2)
SH.Left = ActiveWindow.Width / 2
j'arrive presque à avoir le bon code ,mais je ne peu pas garder le shape sur la cellule
je remet le fichier avec le code modifié

 

[PMO2]

Re : centraliser un shapes en plein écran

Bonjour,

Essayez ce code à mettre dans la fenêtre de code de la feuille concernée (PLAN)

Sub masquetoushapesgevry()
'
' masque tous les shapes de la feuille
'
ActiveSheet.Shapes.SelectAll
Selection.Visible = False
'
End Sub


Sub affichegevry()
'
'affiche le rectangle 3
ActiveSheet.Shapes("Légende encadrée 1 6").Visible = True
End Sub


'############# modif pmo
Private Sub CommandButton1_Click()
On Error GoTo Erreur
ActiveSheet.Shapes.SelectAll
Selection.Visible = False
ActiveSheet.Shapes("Image 5").Visible = True
Erreur:
End Sub

Private Sub CommandButton2_Click()
ActiveSheet.Shapes("Image 5").Visible = True
End Sub

Private Sub CommandButton3_Click()    'Boulangerie
Call CentreShape(ActiveSheet.Shapes("Légende encadrée 1 6"))
End Sub

Private Sub CommandButton4_Click()    'Epicerie
Call CentreShape(ActiveSheet.Shapes("Légende encadrée 1 7"))
End Sub

Private Sub CommandButton5_Click()    'Eglise
Call CentreShape(ActiveSheet.Shapes("Légende encadrée 1 8"))
End Sub

Private Sub CommandButton6_Click()    'Mairie
Call CentreShape(ActiveSheet.Shapes("Légende encadrée 1 9"))
End Sub

Sub CentreShape(SH As Shape)
Dim R As Range
Dim x&
Dim y&
'---
SH.Visible = msoTrue
ActiveCell.Select 'nécessaire pour le rafraîchissement de la Shape
Set R = SH.TopLeftCell
With ActiveWindow
  .ScrollRow = R.Row
  .ScrollColumn = R.Column
  '---
  Set R = .VisibleRange
  y& = (R.Rows.Count \ 2) - 2
  If R.Row < y& Then y& = R.Row - 1
  x& = (R.Columns.Count \ 2) - 1
  If R.Column < x& Then x& = R.Column - 1
  .ScrollRow = R.Row - y&
  .ScrollColumn = R.Column - x&
End With
Set SH = Nothing
End Sub
'############# fin pmo

 

[La Vouivre]

Re : centraliser un shapes en plein écran

Bonsoir mon ami PMO2
Bonsoir le forum
Joli travail ,je viens d'essayer le fichier ,sur mon ordi , les shapes sont centré sur l'écran c'est super ,mais j'ai deux shapes qui me font une erreur 1004 à la ligne

ScrollColumn = R.Column - x&

j'ai aussi essayer la macro sur le fichier du boulot est la surprise rien ne marche
comme je l'avais dit dans mon premier poste les boutons son sur un userform , est-ce pour cela que ça ne fonctionne pas ?

 

[PMO2]

Re : centraliser un shapes en plein écran

comme je l'avais dit dans mon premier poste les boutons son sur un userform , est-ce pour cela que ça ne fonctionne pas ?

OUI

Essayez de faire un classeur simplifié qui reproduit, au plus près, la situation réelle et faites le paraître (avec le UserForm).
Respectez (ou indiquez) la position des 4 Shapes les plus éloignées (ex : la plus haute en H3, la plus à gauche en D25, la plus basse en K280, la plus à droite en BC123)
Sinon, et en ce qui me concerne, je ne peux rien faire.

 

[La Vouivre]

Re : centraliser un shapes en plein écran

Voila j'ai réduit au maxi mon fichier en données ,
j'ai supprimer des macro pour les boutons efface
je vais avoir environ 500 shapes une fois fini

 

[PMO2]

Re : centraliser un shapes en plein écran

Voir
1) les modifications dans le code du UserForm
2) le Module1 (standard) qui a été ajouté

Remarque : seulement quelques Shapes sont reliées au UserForm.

 

[La Vouivre]

Re : centraliser un shapes en plein écran

Merci beaucoup
très beau travail , j'ai réussi à adapter le code à mon fichier ,le résultat est magnifique ,tous les shapes se retrouve centrer sur mon écran.
Je vous remercie énormément pour cette aide ,le fichier va servir à beaucoup de personne pour se situer sur un site industriel;
de la on pourra situer les divers chantiers ainsi que divers point comme les bouches à incendie et autre, je ne vais pas m'étendre sur mon boulot .
Un grand bravo pour votre maitrise du VBA , vous êtes super ,tous grâce à vous je progresse en VBA tous les jours ,faite vivre ce forum un max de temps.
Merci beaucoup
bonne soirée