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
|
Sub photo()
'
' photo Macro
' Macro enregistrée le 23/05/2006 par A.Calvet
Dim cel As Range
For Each cel In Selection
Set fs = Application.FileSearch
With fs
.LookIn = "e:\images\"
.MatchTextExactly = True
.Filename = cel & ".jpg"
If .Execute > 0 Then
ActiveSheet.Pictures.Insert("e:\images\" & cel & ".jpg").Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 113.25
Selection.ShapeRange.Width = 113.25
Selection.ShapeRange.Rotation = 0#
Else
With fs
.LookIn = "e:\images\"
.MatchTextExactly = True
.Filename = cel & Modul(cel) & ".jpg"
If .Execute = 1 Then
ActiveSheet.Pictures.Insert("e:\images\" & cel & Modul(cel) & ".jpg").Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 113.25
Selection.ShapeRange.Width = 113.25
Selection.ShapeRange.Rotation = 0#
End If
End With
End If
ActiveCell.Offset(1, 0).Range("A1").Select
End With
Next
End Sub |
Partager