J’ai réaliser une suite de 2 macros afin d’insérer des séries de photos en première colonne, toute les 5 lignes.
1) les photos à insérer ou non doivent se trouver ds un répertoire c:\\images.
2) Les noms des images à insérer doivent être placées en première colonne
3) <ctrl>+l separe les noms d’image de 4 lignes=5 au total
4) <ctrl>+i recouvre les noms par les images correspondantes
tout peut-être modulé
Qu'en penses-tu?
sarfatij@infonie.fr
Sub inslign()
'
' inslign Macro
' Macro enregistrée le 01/02/04
'
' Touche de raccourci du clavier: Ctrl+l
'
Dim lig
lig = 1
Range('A1').Select
For lig = 1 To 5000
If Cells(lig, 1) <> '' Then
ActiveCell.Offset(1, 0).Rows('1:4').EntireRow.Select
Selection.Insert Shift:=xlDown
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
ActiveCell.Offset(4, 0).Range('A1').Select
End If
Saut:
Next lig
Range('A1').Select
End Sub
---------------------------------------------------------------------------------------------
Sub image()
'
' Touche de raccourci du clavier: Ctrl+i
'
Dim lig
lig = 1
On Error Resume Next
Columns('a:a').ColumnWidth = 17
Range('A1').Select
For lig = 1 To Cells.SpecialCells(xlCellTypeLastCell).Row
If ActiveSheet.Cells(lig, 1) <> '' Then
ActiveSheet.Pictures.Insert('C:\\images\\' & Cells(lig, 1)).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 65
Selection.ShapeRange.Width = 87
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.ZOrder msoBringToFront
Selection.ShapeRange.IncrementTop 3
Selection.ShapeRange.IncrementLeft 3
End If
Saut:
ActiveCell.Offset(1, 0).Range('A1').Select
Next lig
Range('A1').Select
End Sub
