'----------------------
'Intégration du fichier
'----------------------
FileName = Mid(TabFileFullNames(1), InStrRev(TabFileFullNames(1), "\") + 1)
k = InStrRev(FileName, ".")
If k > 0 Then
Extension = LCase(Mid(FileName, k + 1))
Else
Extension = ""
End If
Select Case Extension
Case "pdf"
IconShapeName = "IconePDF"
IconFileName = "PDF.ico"
Case "doc", "docx"
IconShapeName = "IconeWord"
IconFileName = "Word.ico"
Case "xls", "xlsx", "xlsm"
IconShapeName = "IconeExcel"
IconFileName = "Excel.ico"
Case "txt"
IconShapeName = "IconeText"
IconFileName = "Text.ico"
Case Else
IconShapeName = "IconeAutre"
IconFileName = "Autre.ico"
End Select
'Gestion du fichier icône
If Len(Dir(Environ("TEMP") & "\" & IconFileName)) = 0 Then
Set oShell = CreateObject("Shell.Application")
With ThisWorkbook.Worksheets(1).OLEObjects(IconShapeName)
'Save the Embbeded Object
.Copy
oShell.Namespace(Environ("TEMP")).Self.InvokeVerb "Paste"
End With
End If
'Intégration du fichier
If IconShapeName = "IconeWord" Or IconShapeName = "IconeExcel" Then
'Avec Word et Excel impossible de faire ce qu'on veut
Set OLEObject = ActiveSheet.OLEObjects.Add(FileName:=TabFileFullNames(1), Link:=False, DisplayAsIcon:=True, _
IconFileName:=Environ("TEMP") & "\" & IconFileName, _
IconLabel:=DocName, IconIndex:=0, _
Left:=ActiveCell.Left, _
Top:=ActiveCell.Top)
Else
'Avec les applications non-office, pour avoir le nom de fichier sur 1 ligne
Set OLEObject = ActiveSheet.OLEObjects.Add(FileName:=TabFileFullNames(1), Link:=False, _
Left:=ActiveCell.Left, _
Top:=ActiveCell.Top)
End If