bon si tu me dis que la c'est pas bon fait de la peche ou du tricot
allez on croise les doigts
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 Option Explicit Sub test() Dim tabloimage(), WindoWname As String, WbKSource As Workbook, shap, i As Long, cel WindoWname = ThisWorkbook.Name Set WbKSource = Workbooks.Open(ThisWorkbook.Path & "\ES-Catalogue.xlsx") 'on rassemble les images dans un tableau With WbKSource.Sheets("Param Services") ReDim tabloimage(1 To 50) For Each shap In .Shapes If shap.TopLeftCell.Row >= 1 And shap.TopLeftCell.Row <= 50 And shap.TopLeftCell.Column = 4 Then i = i + 1: tabloimage(shap.TopLeftCell.Row) = shap.Name End If Next ReDim Preserve tabloimage(1 To i) 'on elimine les item du tabloimage vides With .Shapes.Range(tabloimage): .Group.Copy: .Ungroup: End With End With Windows(WindoWname).Activate With ActiveSheet Cells(8, 2).Select: .Paste: For Each shap In .Shapes If shap.Type = msoGroup Then shap.Ungroup Next For i = 1 To UBound(tabloimage) Set cel = .Cells(8 + (5 * (i - 1)), 2) With .Shapes(tabloimage(i)): .Left = cel.Left: .Top = cel.Top: .Height = cel.Height: End With Next End With 'on ferme la source image on en a plus besoins Application.DisplayAlerts = False WbKSource.Close End Sub
Partager