Tri Photo + récupération nom fichier sélectionné avec lien hypertexte

[yo61]

Bonjour a tous et merci de me lire

XLS:2007

Voila je me créer une petite base documentaire pour le boulot mais je me retrouve avec deux soucis que j arrive a résoudre.

1-Tri photos

J ai une macro et un bouton sur ma feuille qui me permet d insérer une photo dans la cellule active a la taille de celle-ci. CA fonctionne très bien sauf que lorsque je tri mon tableau les photo ne sont pas triées.

Est il possible de régler ce problème?

2-Maco ajout doc + nom + lien hypertexte.

Donc comme je l ai dis plus haut je souhaite créer un mini base documentaire en listing pour mon boulot mais étant vraiment nul en VBA je sèche. J ai bien essayé en enregistrant une macro mais ca ne marche pas. Pour info les dossiers sont sur le réseau

je aimerai bien le fonctionnement suivant.

1- je sélectionne la cellule que je veux remplir.
2- j appuie sur le bouton ajout doc
3- J ouvre le dossier ou se trouve le document a ajouté (chemin rentré en dur dans la macro.
4- Je sélectionne le document que je souhaite
5- et ça me copie dans la cellule le nom du doc en lien hypertexte pour l ouvrir

Merci de votre aide.

 

[yo61]

Re : Tri Photo + récupération nom fichier sélectionné avec lien hypertexte

Rebonjour,

Après plusieurs recherche sur le forum j ai trouver une macro ecrite par Theze qui répond en parti a mes besoins.
Je l ai donc modifié suivant mes besoin voir ci dessous

Sub Recup()

Dim Fso As Object
Dim F As Object
Dim Fichier As Variant

Fichier = RetourFichier(ActiveCell.Value)

If Fichier <> False Then

' Range("B1") = Dir(Fichier)

Set Fso = CreateObject("Scripting.FileSystemObject")

If Fso.FileExists(Fichier) = True Then

Set F = Fso.GetFile(Fichier)

' ActiveCell = Left(F.Path, InStrRev(F.Path, "\"))
ActiveCell = Dir(F.Path)
'´Range("B9") = F.DateLastModified

End If
End If

End Sub

Function RetourFichier(Chemin As String) As Variant

'1 ouvrir un fichier
'2 enregistrement de fichier
'3 sélection de fichier
'4 sélection de dossier

With Application.FileDialog(3)

.AllowMultiSelect = False
.Filters.Add "Tous Fichiers", "*.*", 1
.InitialFileName = Chemin
.Show

On Error Resume Next 'si annuler
RetourFichier = .SelectedItems(1)

If Err.Number <> 0 Then RetourFichier = False

End With

End Function


Par contre je ne sais pas comment modifier les point suivant:

Écrire dans le code le dossier a ouvrir
et créer le lien hypertexte

merci de votre aide

 

[yo61]

Re : Tri Photo + récupération nom fichier sélectionné avec lien hypertexte

J avance gentiment youpy j arrive maintant a ouvrir le dossier désiré et copier le nom du fichier dans la cellule active
Il ne me manque qu a créer le lien hypertext

Sub Recup()

Dim Fso As Object
Dim F As Object
Dim Fichier As Variant

Fichier = RetourFichier(ActiveCell.Value)

If Fichier <> False Then

' Range("B1") = Dir(Fichier)


Set Fso = CreateObject("Scripting.FileSystemObject")

If Fso.FileExists(Fichier) = True Then

Set F = Fso.GetFile(Fichier)

' ActiveCell = Left(F.Path, InStrRev(F.Path, "\"))
ActiveCell = Dir(F.Path)
'´Range("B9") = F.DateLastModified

End If
End If

End Sub

Function RetourFichier(Chemin As String) As Variant

'1 ouvrir un fichier
'2 enregistrement de fichier
'3 sélection de fichier
'4 sélection de dossier

Chemin = "N:\Qualite\PlanQualité"

With Application.FileDialog(3)

.AllowMultiSelect = False
.Filters.Add "Tous Fichiers", "*.*", 1
.InitialFileName = Chemin
.Show

On Error Resume Next 'si annuler
RetourFichier = .SelectedItems(1)

If Err.Number <> 0 Then RetourFichier = False

End With

End Function

 

[yo61]

Re : Tri Photo + récupération nom fichier sélectionné avec lien hypertexte

Voila la solution pour ce qui concerne le lien hypertext
par contre je n ai pas de réponse concernant les tris merci de votre aide


Sub Recup()

Dim Fso As Object
Dim F As Object
Dim Fichier As Variant
Dim Chemin
Fichier = RetourFichier(ActiveCell.Value)

If Fichier <> False Then


Set Fso = CreateObject("Scripting.FileSystemObject")

If Fso.FileExists(Fichier) = True Then

Set F = Fso.GetFile(Fichier)

' Enregistrement du chemin du fichier dans l variable Chemin
Chemin = Left(F.Path, InStrRev(F.Path, "\"))
' ActiveCell = Left(F.Path, InStrRev(F.Path, "\"))
' Ecrire dans la cellule active le nom du fichier sélectionnné
ActiveCell = Dir(F.Path)
'´Range("B9") = F.DateLastModified

' Création du lien hypertexte.
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
Chemin & ActiveCell.Value, TextToDisplay:= _
ActiveCell.Value

End If
End If

End Sub

Function RetourFichier(Chemin As String) As Variant

'1 ouvrir un fichier
'2 enregistrement de fichier
'3 sélection de fichier
'4 sélection de dossier

Chemin = "N:\Qualite\PlanQualité"

With Application.FileDialog(3)

.AllowMultiSelect = False
.Filters.Add "Tous Fichiers", "*.*", 1
.InitialFileName = Chemin
.Show

On Error Resume Next 'si annuler
RetourFichier = .SelectedItems(1)

If Err.Number <> 0 Then RetourFichier = False

End With

End Function

 

[job75]

Re : Tri Photo + récupération nom fichier sélectionné avec lien hypertexte

Bonjour yo61, le forum,

par contre je n ai pas de réponse concernant les tris merci de votre aide

Les photos suivent sans problème les cellules lors du tri sur les colonnes B C D E F G.

Par contre rien ne se passe quand on trie sur la colonne A (PHOTOS).

Raison : il n'y a rien dans les cellules en colonne A.

Si vous voulez trier le tableau par le nom des photos, inscrire le nom de la photo dans la cellule.

Par exemple :

Sub Inserer_Image()
'----
If Image <> False Then
ActiveCell = ActiveSheet.Shapes.AddPicture(Image, True, True, L, T, W, H).Name
End If
End Sub

A+

 

[job75]

Re : Tri Photo + récupération nom fichier sélectionné avec lien hypertexte

Bonjour yo61, le forum,

En fait vous voulez donner à l'image le nom du fichier source :

Sub Inserer_Image()
Dim Image As Variant, o As Object
Dim L As Single, T As Single, W As Single, H As Single

With ActiveCell
L = .Left
T = .Top
W = .Width
H = .Height
End With

Image = Application.GetOpenFilename
If Image <> False Then
Set o = ActiveSheet.Shapes.AddPicture(Image, True, True, L, T, W, H)
ActiveCell = Mid(Image, InStrRev(Image, "\") + 1, 999)
On Error Resume Next
o.Name = ActiveCell
If Err Then MsgBox "Photo déjà utilisée..."
End If
End Sub

Edit : ajouté MsgBox.

A+

 

[yo61]

Re : Tri Photo + récupération nom fichier sélectionné avec lien hypertexte

Bonjour Job 75

Merci beaucoup pour votre aide je vais tester votre solution

mais je pense que je vais supprimer l ajout de photo dans mon fichier et le remplacer par un lien hypertexte car ça l alourdie beaucoup même avec des photo en 800*600.

bonne journée

 

[yo61]

Re : Tri Photo + récupération nom fichier sélectionné avec lien hypertexte

Je viens d essayer votre code ca marche super par contre chez moi losque je fait un tri ou un filtre sur mon tableau les images ne bouge pas. Par exemple apres un tri l image en A12 devrais erre en A23 mais elle reste en A12 en espérant que je sois clair

Bonne journée

 

[job75]

Re : Tri Photo + récupération nom fichier sélectionné avec lien hypertexte

Re,

Je viens d essayer votre code ca marche super par contre chez moi losque je fait un tri ou un filtre sur mon tableau les images ne bouge pas.

Ca marche super ou ça ne marche pas super ?

Si vous triez sur la colonne A il faut que les cellules en colonne A contiennent le nom de l'image.

Il faut aussi que dans Format de l'image (clic droit) ce soit l'une de ces propriétés qui soit choisie :

Déplacer et dimensionner avec les cellules
Deplacer sans dimensionner avec les cellules

J'ai testé sous Excel 2003 et Excel 2010, il n'y a aucun problème.

A+

 

[yo61]

Re : Tri Photo + récupération nom fichier sélectionné avec lien hypertexte

Bonsoir

apres un nouvelle essaie cela ne fonctionne pas

si je fait un tri sur la colonne A les nom des image sont bien trié dans le tableau mais les image ne suive pas.
L option Déplacer et dimensionner avec les cellules est bien sélectionné pour chaque image

je dois surement faire une faire une mauvaise manip qq part mais bon c est pas grave
Merci beaucoup de votre aide
je vais donc finalement passer par des lien hypertexte question de poids du fichier.

Bonne soirée et encore merci