XL 2010 VBA agrandir/ reduire Image : Agrandissement au centre de la feuille Excel ou à partir de la cellule A1

[derk]

bojour à tous,

je souhaites par simple clique qu'une image grandisse mais ce n'est pas tout, je veux que le zoom se fasse au centre de la feuille Excel
bien sur le reclique sur l'image devait la remettre à sa taille d'origine (petite)
voici un code que j'ai pu récupérer dans un autre fomrum qui fonctionne super bien mais n'integre pas l'option agrandire au centre de la feuille

pouvez vous m'aider SVP ?


Private Sub Agrandir_image()
ActiveSheet.Shapes.Range(Array(Application.Caller)).Select
Selection.ShapeRange.ZOrder msoBringToFront
Selection.ShapeRange.Width = 610
Selection.OnAction = "Diminuer_image"
ActiveSheet.Shapes(Application.Caller).TopLeftCell.Select

End Sub
Private Sub Diminuer_image()
ActiveSheet.Shapes.Range(Array(Application.Caller)).Select
Selection.ShapeRange.Height = 100
Selection.OnAction = "Agrandir_image"
Range("a1").Select
End Sub
Sub initialiser()
For Each Image In ActiveSheet.Shapes
Image.OnAction = "Agrandir_image"
Next Image
End Sub

 

[fanch55]

Bonsoir, A tester :

Public Base As Range
Sub Agrandir_image()
With ActiveSheet.Shapes(Application.Caller)
    .ZOrder msoBringToFront
    .Width = 610
    .OnAction = "Diminuer_image"
    Set Base = .TopLeftCell
    .Left = (ActiveWindow.VisibleRange.Width - .Width) / 2
    .Top = (ActiveWindow.VisibleRange.Height - .Height) / 2
End With

End Sub
Sub Diminuer_image()
With ActiveSheet.Shapes(Application.Caller)
    .Height = 100
    .OnAction = "Agrandir_image"
    .TopLeftCell = Base
    .Left = Base.Left
    .Top = Base.Top
End With
End Sub
Sub initialiser()
For Each Image In ActiveSheet.Shapes
    Image.OnAction = "Agrandir_image"
Next Image
End Sub

 

[patricktoulon]

Bonsoir a tous
1°sauf erreur de ma part il y a déformation de l'image en adaptant les deux usable - taille /2
sauf si les images n'ont pas eu le lockaspectratio modifié a false ,au quel cas c'est pas bon non plus car la c'est le placement qui ne sera pas centré car le redim de l'un annule celui de l'autre

2° et c'est pas les usable de l'app mais le activewindow.visiblerange .width et .height qui serait plus appropriés

 

[fanch55]

Salut Pat,
1° N'ayant pas d'exemple concret, j'ai conservé les tailles indiquées, au demandeur de les adapter ...
2° Effectivement, il vaut mieux utiliser le visiblerange surtout si on joue avec Ctrl+Roulette.
Post précédent modifié avec ta remarque appropriée

 

[patricktoulon]

bonsoir fanch55

 With ActiveWindow.VisibleRange
        L = ((.Width - lashap.Width) / 2) + .Cells(1).Left
        T = ((.Height - lashap.Height) / 2) + .Cells(1).Top
End With
    'utiliser L et T

d'apres toi pourquoi le +cell....

 

[fanch55]

Bonjour Pat,
Je ne vois pas trop l'intérêt, ce n'est pas faute de tester, .cells(1).left et cells(1).top toujours = 0 ?
Y'aurait un effet collatéral à l'insu de mon plein gré ?

 

[fanch55]

Fichier de test
J'y ai inclus la restauration des images ( auto_open, Workbook_BeforeSave )