Barre d'onglet avec photo

Option Explicit

Dim varOk As Boolean
Dim memoZoom As Long, memoLeft(1 To 4) As Long, memoTop(1 To 4) As Long

Private Sub Workbook_Open()
    Dim Sh As Worksheet, i As Long
    Set Sh = ActiveSheet
    With Sheets("Feuil1")
        .Activate
        memoZoom = ActiveWindow.Zoom
        For i = 1 To 4
            memoLeft(i) = .Shapes("Image " & i).Left
            memoTop(i) = .Shapes("Image " & i).Top
        Next i
    End With
    Sh.Activate
    varOk = True
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh.Name = "Feuil1" Then majZoom
End Sub

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    If Sh.Name = "Feuil1" Then majZoom
End Sub

Sub majZoom()
    Dim s As Shape, i As Long
    If ActiveWindow.Zoom <> memoZoom And varOk Then
        For i = 1 To 4
            ActiveSheet.Shapes("Image " & i).Select
            Selection.ShapeRange.ScaleWidth memoZoom / ActiveWindow.Zoom, msoFalse, msoScaleFromTopLeft
            Selection.ShapeRange.ScaleHeight memoZoom / ActiveWindow.Zoom, msoFalse, msoScaleFromTopLeft
            Selection.ShapeRange.Left = memoLeft(i) * memoZoom / ActiveWindow.Zoom
            memoLeft(i) = Selection.ShapeRange.Left
            Selection.ShapeRange.Top = memoTop(i) * memoZoom / ActiveWindow.Zoom
            memoTop(i) = Selection.ShapeRange.Top
        Next i
        memoZoom = ActiveWindow.Zoom
    End If
End Sub