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
| Sub j_espere_que_ca_marche()
Dim i As Long, path As String, sep As String, img As String
Dim sh As Worksheet
sep = Application.PathSeparator
path = ActiveWorkbook.path & sep & "images" & sep
' balaye les 700 lignes
For i = 1 To 15
If Cells(i, Application.Columns.Count).Value = "" Then
' indique à Excel où insérer l'image
Cells(i, 2).Select
' insère une image jpg
img = path & Cells(i, 1).Value & ".jpg"
If Dir(img) = "" Then
MsgBox "Image """ & img & """ non trouvée"
Else
MettreImageDansCellule path & sep & Cells(i, 1) & ".jpg", i, 2
Cells(i, Application.Columns.Count).Value = "X"
End If
'...
End If
Next i
End Sub
Sub MettreImageDansCellule(NomImage As String, Ligne As Long, Colonne As Long)
'definir variable
Dim P As Object
Dim T As Double, TR As Double, TP As Double
Dim L As Double, LR As Double, LP As Double
Dim W As Double, WR As Double, WP As Double
Dim H As Double, HR As Double, HP As Double
If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
If Dir(NomImage) = "" Then Exit Sub
' import picture
Set P = ActiveSheet.Pictures.Insert(NomImage)
' determiner positions
With P
.Top = Rows(Ligne).Top + 5
.Left = Columns(Colonne).Left
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 30#
.ShapeRange.Width = 100#
.ShapeRange.Rotation = 0#
End With
'adapter largeur colonne
If Columns(Colonne).ColumnWidth < P.Width Then Columns(Colonne).ColumnWidth = P.Width
'adapter hauteur ligne
Rows(Ligne).RowHeight = P.Height + 10
Set P = Nothing
End Sub |
Partager