Discussion :

[PixelsBoy]

Bonjour,

J'aimerai réaliser un petit menu, simple, avec 5 "pictos"
Pour l'instant ils sont en vectoriels dégroupé, et chaque groupe, dans le volet section a une appellation (Menu01A, Menu 02A etc.)

J'aimerai un code VBA qui agrandisse se groupe (légèrement), en % et pouvoir choisir le point d'encrage (centre bas) de l'agrandissement.

L'image peut aussi être plus simplement juste un .jpg ou .svg non dégroupé si besoin pour le code.

J'aimerai qu'avec l'insertion d'action, je puisse au survol déclenché l'agrandissement de l'image qu'on survol, retour à sa taille originelle quand la souris quitte la surface de l'image (ou d'un bloc en transparence si besoin)


j'ai fait un petit exemple, en utilisant plusieurs slides, pour montrer le rendu attendu (renommer .zip en .pptx)

Test.zip

J'ai fouillé le web avant de venir poser mon sujet, et je n'arrive à rien avec les différentes lignes de code que je trouve à droite à gauche.

Merci infiniment pour vos aides

[mromain]

Bonjour PixelsBoy, le forum,


J’arrive un peu après la bataille, mais avec quelque chose qui semble se rapprocher de ce que tu veux.

La macro permettant de zoomer / dézoomer une forme est la suivante.

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
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
Public Enum AnchorMode
    Center = 1
    Top = 2
    Bottom = 3
    Left = 4
    Right = 5
    TopLeft = 6
    TopRight = 7
    BottomLeft = 8
    BottomRight = 9
End Enum
 
 
Public Sub ZoomShape(shp As Shape, modeAnchor As AnchorMode, zoom As Double)
Dim newTop As Double
Dim newLeft As Double
    With shp
        Select Case modeAnchor
            Case AnchorMode.Center
                newTop = .Top + (1 - zoom) * .Height / 2
                newLeft = .Left + (1 - zoom) * .Width / 2
            Case AnchorMode.Top
                newTop = .Top
                newLeft = .Left + (1 - zoom) * .Width / 2
            Case AnchorMode.Bottom
                newTop = .Top + (1 - zoom) * .Height
                newLeft = .Left + (1 - zoom) * .Width / 2
            Case AnchorMode.Left
                newTop = .Top + (1 - zoom) * .Height / 2
                newLeft = .Left
            Case AnchorMode.Right
                newTop = .Top + (1 - zoom) * .Height / 2
                newLeft = .Left + (1 - zoom) * .Width
            Case AnchorMode.TopLeft
                newTop = .Top
                newLeft = .Left
            Case AnchorMode.TopRight
                newTop = .Top
                newLeft = .Left + (1 - zoom) * .Width
            Case AnchorMode.BottomLeft
                newTop = .Top + (1 - zoom) * .Height
                newLeft = .Left
            Case AnchorMode.BottomRight
                newTop = .Top + (1 - zoom) * .Height
                newLeft = .Left + (1 - zoom) * .Width
        End Select
        .Top = newTop
        .Left = newLeft
        .Height = .Height * zoom
        If Not .LockAspectRatio Then .Width = .Width * zoom
    End With
End Sub

Tu trouveras dans le fichier joint deux exemples :
La macro TestZoom qui zoome sur chaque forme du menu :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub TestZoom()
Dim shp As Shape
Dim i As Long
 
    'boucler sur toutes les formes de la première diapo
    With ActivePresentation.Slides(1)
        For i = 1 To 5
            Set shp = .Shapes("Menu_" & i)
            ZoomShape shp, Bottom, 1.5          'zoomer centré en bas
            MsgBox "Etape " & i, vbInformation, "Test zoom"
            ZoomShape shp, Bottom, 1 / 1.5      'dézoomer
        Next i
    End With
End Sub

Et un exemple au survol de la souris en mode présentateur (avec des actions).

TestZoom.zip

A+

[PixelsBoy]

Je vois que ça fonctionnne parfaitement,
Merci @mromain je vais aller décortiquer ça pour comprendre et pouvoir le réappliquer !