Microsoft 365 Cliquer pour ouvrir des photos

Simon 1234 · 16 Avril 2025

Bonjour à tous
Pour un collègue je créer un outil. On y fait la liste de machines, quand on clique sur le nom de la machine ça ouvre les photos de cette machine.
Pour une machine "toto", les photos doivent être nommées "toto1.jpg , toto2.jpg", ça me semble plus simple à retrouver.
Le fichier excel est dans un dossier "MACHINES". Les photos ont leur propre dossier "PHOTOS" dans ce même dossier "MACHINES"; donc \MACHINES\PHOTOS.

Les noms de machines sont dans la colonne A. Une macro, à l'ouverture du fichier, vérifie si des photos sont présentes et les liste, et retire ".jpg". Ainsi, avec Equiv, j'arrive à faire la correspondance entre le nom des machines et le nom des photos. La colonne B affiche une icône de lunettes si des photos sont disponibles.

Ca marche, mais bizarrement, j'ai un problème avec le compteur dans le code. Je joins le dossier parce que c'est compliqué à expliquer mais lorsqu'on clique sur des lunettes, ca ouvre les photos de la machine mais aussi celles des machines précédentes.

D'avance merci à toute personne qui m'aidera à terminer ce projet.
Bonne journée.

Le code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Erreur

Dim NumCell As Integer
Dim MachineName As String
Dim dossier As String
dossier = ActiveWorkbook.Path & "\PHOTOS\"
Dim NomFichier As String
Dim CheminComplet As String
Dim Compteur As Byte

If Selection.Count = 1 Then
If Not Intersect(Target, Range("B2:B50")) Is Nothing Then
NumCell = Target.Row
MachineName = Range("A" & NumCell).Value

If MachineName <> "" Then 'une machine sur cette ligne
MsgBox MachineName
Compteur = 1
CheminComplet = dossier & MachineName & Compteur & ".jpg"

If Dir(CheminComplet) <> "" Then
Range("B2").Select
ActiveSheet.Pictures.Insert(CheminComplet).Select
'redimensionner
Selection.ShapeRange.ScaleHeight 0.79, msoFalse, msoScaleFromTopLeft
Compteur = Compteur + 1

End If 'dir chemin non vide
End If 'if not intersect
End If 'if selec count
GoTo Fin
Else
GoTo Fin
End If 'test machinename vide

Erreur:
MsgBox ("Une erreur est survenue, merci de réessayer")
Fin:
End Sub

Simon 1234 · 23 Avril 2025

Jacky67 à dit:
Re..
Pour faire en une fois tous ceux déjà présent
Dans un module

Code:

Sub tous() Dim dossier$, lig& dossier = ActiveWorkbook.Path & "\PHOTOS\" lig = Feuil1.Cells(Feuil1.Rows.Count, "A").End(xlUp).Row Application.ScreenUpdating = False For Each c In Feuil1.Range("a2:a" & lig) If Dir(dossier & c & ".jpg") <> "" Then With c.Offset(, 1) .Select .InsertPictureInCell (dossier & c & ".jpg") End With Else c.Offset(, 1) = "N/C" End If Next End Sub

Il est évident que les photos doivent avoir comme nom celui des cellules en colonne A (toto.jpg, tata.jpg... etc...)

Merci, vraiment
Une nouvelle occasion de paraître...

sylvanu · 16 Avril 2025

Bonjour Simon,
Vous avez une ré entrance dans votre macro Worksheet_SelectionChange.
Lorsque vous cliquez sur une cellule vous activez la macro. Mais comme dans la macro vous avez un "Range("B2").Select" vous relancez la macro une seconde fois.
Pour éviter ça, il faut bloquer les événements avec :

VB:

Application.EnableEvents = False  ' Stoppe les events
Application.EnableEvents = True   ' Autorise les events

Simon 1234 · 16 Avril 2025

sylvanu à dit:
Bonjour Simon,
Vous avez une ré entrance dans votre macro Worksheet_SelectionChange.
Lorsque vous cliquez sur une cellule vous activez la macro. Mais comme dans la macro vous avez un "Range("B2").Select" vous relancez la macro une seconde fois.
Pour éviter ça, il faut bloquer les événements avec :

VB:

Application.EnableEvents = False ' Stoppe les events Application.EnableEvents = True ' Autorise les events

Ah merci

Maintenant j'ai besoin de mettre ça dans une boucle pour ouvrir toutes les photos qui correspondent à un nom de machine et le tour est joué.
Encore merci, je ne trouvais pas le problème, c'est très sympa.

sylvanu · 16 Avril 2025

Re,
Penser à mettre le True à la fin :

VB:

Application.EnableEvents = True   ' Autorise les events
End Sub

Car sinon votre macro sera inhibée jusqu'à la fermeture du fichier.

Jacky67 · 16 Avril 2025

Simon 1234 à dit:
Bonjour à tous
Pour un collègue je créer un outil. On y fait la liste de machines, quand on clique sur le nom de la machine ça ouvre les photos de cette machine.
Pour une machine "toto", les photos doivent être nommées "toto1.jpg , toto2.jpg", ça me semble plus simple à retrouver.
Le fichier excel est dans un dossier "MACHINES". Les photos ont leur propre dossier "PHOTOS" dans ce même dossier "MACHINES"; donc \MACHINES\PHOTOS.

Les noms de machines sont dans la colonne A. Une macro, à l'ouverture du fichier, vérifie si des photos sont présentes et les liste, et retire ".jpg". Ainsi, avec Equiv, j'arrive à faire la correspondance entre le nom des machines et le nom des photos. La colonne B affiche une icône de lunettes si des photos sont disponibles.

Ca marche, mais bizarrement, j'ai un problème avec le compteur dans le code. Je joins le dossier parce que c'est compliqué à expliquer mais lorsqu'on clique sur des lunettes, ca ouvre les photos de la machine mais aussi celles des machines précédentes.

D'avance merci à toute personne qui m'aidera à terminer ce projet.
Bonne journée.

Le code:

Bonjour à tous
Cet exemple place l'image dans la cellule adjacente à la saisie de la colonne A a chaque fois que l'on saisie ou modifie la cellule colonne A
<a placer dans un même répertoire

Simon 1234 · 16 Avril 2025

Jacky67 à dit:
Bonjour à tous
Cet exemple place l'image dans la cellule adjacente à la saisie de la colonne A a chaque fois que l'on saisie ou modifie la cellule colonne A
<a placer dans un même répertoire

Ah chouette, merci, l'idée est excellente
Merci à vous deux.
Du coup je laisse courir le fil un peu, on sait jamais 😛

Jacky67 · 16 Avril 2025

Simon 1234 à dit:
Du coup je laisse courir le fil un peu, on sait jamais 😛

Re..
Pour faire en une fois tous ceux déjà présent
Dans un module

Code:

Sub tous()
    Dim dossier$, lig&
    dossier = ActiveWorkbook.Path & "\PHOTOS\"
    lig = Feuil1.Cells(Feuil1.Rows.Count, "A").End(xlUp).Row
    Application.ScreenUpdating = False
    For Each c In Feuil1.Range("a2:a" & lig)
         If Dir(dossier & c & ".jpg") <> "" Then
            With c.Offset(, 1)
                .Select
                .InsertPictureInCell (dossier & c & ".jpg")
            End With
        Else
            c.Offset(, 1) = "N/C"
        End If
    Next
End Sub

Il est évident que les photos doivent avoir comme nom celui des cellules en colonne A (toto.jpg, tata.jpg... etc...)

Simon 1234 · 23 Avril 2025

Jacky67 à dit:
Re..
Pour faire en une fois tous ceux déjà présent
Dans un module

Code:

Sub tous() Dim dossier$, lig& dossier = ActiveWorkbook.Path & "\PHOTOS\" lig = Feuil1.Cells(Feuil1.Rows.Count, "A").End(xlUp).Row Application.ScreenUpdating = False For Each c In Feuil1.Range("a2:a" & lig) If Dir(dossier & c & ".jpg") <> "" Then With c.Offset(, 1) .Select .InsertPictureInCell (dossier & c & ".jpg") End With Else c.Offset(, 1) = "N/C" End If Next End Sub

Il est évident que les photos doivent avoir comme nom celui des cellules en colonne A (toto.jpg, tata.jpg... etc...)

Merci, vraiment
Une nouvelle occasion de paraître intelligent 😀

Microsoft 365 Cliquer pour ouvrir des photos

Simon 1234

XLDnaute Junior

Pièces jointes

Simon 1234

sylvanu

XLDnaute Barbatruc

Pièces jointes

Simon 1234

XLDnaute Junior

sylvanu

XLDnaute Barbatruc

Jacky67

XLDnaute Barbatruc

Pièces jointes

Simon 1234

XLDnaute Junior

Jacky67

XLDnaute Barbatruc

Simon 1234

XLDnaute Junior

Discussions similaires

Microsoft 365 Cliquer pour ouvrir des photos

XLDnaute Junior

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Junior

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Junior

XLDnaute Barbatruc

XLDnaute Junior

Discussions similaires

Privacy & Transparency

Privacy & Transparency