Plusieurs images pour la même cellule, mais cela ne nuit pas au menu contextuel qui reste normal | |
Le "mauvais menu" affiché est consécutif à un maintien prolongé du "clic droit" |
Voulez-vous vraiment récupérer le nom de la photo lors de son insertion ?
Cela est faisable (par code) mais absolument pas représentatif,
ce nom pouvant être n'importe quoi et sans rapport avec le contenu ....
Sub Insert_Me()
If ActiveCell.Column = Columns("J").Column Then
ActiveCell.RowHeight = 57: ActiveCell.ColumnWidth = 10
With Application.FileDialog(msoFileDialogFilePicker)
.InitialFileName = Getpath(&H27) & "\*.jpg"
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Fichiers Photos", "*.jpg;*.jpeg"
.Title = "Sélection d'une photo"
If .Show Then
Target = .SelectedItems(1)
With ActiveSheet.Pictures.Insert(Target)
.Name = Target
If .Height > ActiveCell.Height Then .Height = ActiveCell.Height
If .Width > ActiveCell.Width Then .Width = ActiveCell.Width
End With
T = InputBox("Entrez le nom explicite de la photo", "Description Photo", Target)
ActiveCell.Offset(, 1) = IIf(T = "", Target, T)
End If
End With
End If
End Sub
Function Getpath(Cible As Variant) As String
Dim ObjShell As Object
On Error Resume Next
Set ObjShell = CreateObject("Shell.Application").Namespace(Cible).self
If ObjShell Is Nothing Then Getpath = vbNullString Else Getpath = ObjShell.Path
Set ObjShell = Nothing
End Function
Bonsoir,
Le vba ce n’est pas trop mon truc, l’exécution s’arrête sur target avec variable non définie et je ne sais quoi faire
Sub Insert_Me()
Dim Target,T
If ActiveCell.Column = Columns("J").Column Then
ActiveCell.RowHeight = 57: ActiveCell.ColumnWidth = 10
With Application.FileDialog(msoFileDialogFilePicker)
.InitialFileName = Getpath(&H27) & "\*.jpg"
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Fichiers Photos", "*.jpg;*.jpeg"
.Title = "Sélection d'une photo"
If .Show Then
Target = .SelectedItems(1)
With ActiveSheet.Pictures.Insert(Target)
.Name = Target
If .Height > ActiveCell.Height Then .Height = ActiveCell.Height
If .Width > ActiveCell.Width Then .Width = ActiveCell.Width
End With
T = InputBox("Entrez le nom explicite de la photo", "Description Photo", Target)
ActiveCell.Offset(, 1) = IIf(T = "", Target, T)
End If
End With
End If
End Sub
Function Getpath(Cible As Variant) As String
Dim ObjShell As Object
On Error Resume Next
Set ObjShell = CreateObject("Shell.Application").Namespace(Cible).self
If ObjShell Is Nothing Then Getpath = vbNullString Else Getpath = ObjShell.Path
Set ObjShell = Nothing
End Function
Si l'image s'insère au bon endroit, la cellule la contient forcément, ou je n'ai pas bien compris. ..L’image s’insère au bon endroit mais n’est pas traitée et la cellule reste vide.