Discussion :

[Willo83]

Bonjour,
mon classeur Excel contient environ 300 feuilles.
Sur chaque feuille, il y a 2 images.
J'aimerais sélectionner juste une seule image par feuille et les redimensionner à taille égale.
J'ai trouvé un bout de code sur le forum qui me permet de sélectionner la bonne image grâce à son emplacement sur la feuille, mais seulement sur la feuille active.

Sub Dimension()
For Each s In ActiveSheet.Shapes
If Not Intersect(s.TopLeftCell, Range("$A$1:$T25")) Is Nothing Then
s.Select False
End If
Next s
End Sub

Comment adapter ce code de façon a élargir la sélection sur toutes les feuilles et y insérer les dimensions que je veux?

Merci pour votre aide.

[jurassic pork]

Hello,
il est bizarre ton code :
1 - tu fais un shape select avec replace à false ce qui veut dire que tu étends la sélection avec l'objet précédemment sélectionné.
2 - On ne voit pas de code de redimensionnement.

si il y a deux images par feuille : où se situent ces deux images (plages) ? toujours au même endroit ?

Ami calmant, J.P

[Willo83]

Bonjour,
sur chaque feuilles, les images se trouvent toujours au même endroit.

[jurassic pork]

Pour pouvoir t'aider il faudrait voir à quoi ressemble ton classeur avec seulement 2 ou trois feuilles. Si il y a des données confidentielles les enlever. Pour les images si elles sont confidentielles :
cliquer droit sur l'image puis faire changer d'image / A partir d'icones et choisir n'importe quelle icone.

[Willo83]

Voici un exemple de classeur.
J'aimerai redimensionner à la même taille, sur toutes feuilles , seulement l'image se situant en haut de la feuille.
Merci pour ton aide

[mromain]

Bonjour Willo83, jurassic pork, le forum,

Une proposition ci-dessous :

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
Public Sub RedimFirstShapes()
Dim shp As Shape
Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        Set shp = GetTopShape(ws)
        If Not shp Is Nothing Then
            shp.Width = 15
            shp.Height = 15
        End If
    Next ws
End Sub
 
Private Function GetTopShape(ws As Worksheet) As Shape
Dim topRow As Long
Dim shp As Shape
    topRow = ws.Rows.Count
    For Each shp In ws.Shapes
        If shp.TopLeftCell.Row < topRow Then
            topRow = shp.TopLeftCell.Row
            Set GetTopShape = shp
        End If
    Next shp
End Function

A+