Sub Macro_Photo_FRED()
Dim rngTmp As Range
Dim rowTmp As Range
Dim rngInsert As Range
Dim tmpFamily As String
Dim tmpPath As String
Dim tmpFile As String
Dim tmpFileOrig As String
Dim cell_photo As Range
Dim img As Object
Dim dblFactorH As Variant
Dim Pic As Shape
Set rngTmp = Selection
tmpFile = "Ces articles n'existent pas en photo"
tmpFileOrig = tmpFile
Dim posColstr As String
Dim posCol As Integer
posColstr = InputBox("En quelle colonne voulez-vous inserer vos photos (1, 2, 3...)?", "Colonne", 1)
posCol = CInt(posColstr)
If posCol = 0 Then posCol = 1
For Each rowTmp In rngTmp.Rows
tmpFamily = Mid(rowTmp.Cells(1, 1), 4, 2)
tmpPath = "\\10.0.1.185\projects\COMMUN\PHOTOS skus" + "\" + CStr(rowTmp.Cells(1, 1)) + ".jpg"
If Dir(tmpPath) <> "" Then
ActiveSheet.Cells(rowTmp.Cells(1, 1).Row, rowTmp.Cells.Column).Select
ActiveSheet.Cells(Selection.Row, posCol).Select
Set Pic = ActiveSheet.Shapes.AddPicture(Filename:=tmpPath, _
Linktofile:=msoFalse, SaveWithDocument:=msoTrue, Left:=ActiveCell.Left, _
Top:=ActiveCell.Top, Width:=-1, Height:=-1)
With Pic
Pic.LockAspectRatio = msoTrue
Pic.Width = ActiveCell.Width
Pic.Left = ActiveCell.Left
Pic.Top = ActiveCell.Top
Pic.Height = ActiveCell.Height
End With
Else
tmpFile = tmpFile + vbCrLf + rowTmp.Cells(1, 1)
End If
Next rowTmp
If tmpFile <> tmpFileOrig Then
MsgBox tmpFile
End If
End Sub