XL 2021 Extraction images depuis commentaire de cellule vers dossier.

jeff1494 · 26 Janvier 2025

Bonjour à toutes et tous;

J'ai un fichier contenant plusieurs feuilles, dont une nommée "INVENDUS" qui contient une liste d'objets.
Une ligne par objet, et en colonne 2 j'ai la description de l'objet qui contient en commentaire une photo de l'objet.

Je voudrais par macro , pour chaque ligne pouvoir extraire la photo contenue en colonne 2, et la sauvegarder dans un dossier que je nomme "JPG_INV", avec comme nom la valeur de la cellule A de la ligne, et une extension ".jpg".

Pour ce faire j'ai récupéré une macro donnée par @patricktoulon sur un autre forum dans un message dont voici le lien (message #15).
Je l'ai placé dans un module nommé "Export_Images".

J'ai juste adapté le code pour correspondre à mes besoins, à priori rien qui ne puisse changer le fonctionnement de la macro.

Le résultat de l'exécution de cette macro, est que je crée bien les images dans le répertoire défini, mais juste la première images qui est affichée comme un carré blanc dans l'explorateur de Windows.

Donc si jamais @patricktoulon passait par là, je lui serais reconnaissant de bien vouloir m'aider à comprendre pourquoi la première image reste comme un carré blanc, alors que les suivantes sont correctement créées. Mais si une autre personne a une idée du pourquoi du comment je suis preneur.

A toutes fins utiles je vous joins un exemple du fichier que j'utilise.

D'avance je remercie tous ceux ou celles qui voudront bien perdre un peu de leur temps pour m'aider.
Bonne journée à toutes et tous.

laurent950 · 26 Janvier 2025

Bonsoir @jeff1494

"Il manquait cela : .Activate"

Pour comprendre ici en Poste #38 : https://excel-downloads.com/threads/export-dimages-renommer-celles-ci.20034890/post-20674531

VB:

Option Explicit

Sub Export_Photos()
    Dim i As Long
    On Error Resume Next
    MkDir ThisWorkbook.Path & "\JPG_INV"
    Err.Clear
'    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets.Add(After:=Sheets("INVENDUS")).Name = "Feuille_Transit"
    
    With Sheets("Feuille_Transit").ChartObjects.Add(0, 0, 100, 100).Chart
        .Parent.Name = "calque"
    End With
    For i = 2 To Sheets("INVENDUS").Cells(Rows.Count, 2).End(xlUp).Row
        If Sheets("INVENDUS").Cells(i, 2).Comment.Shape.Fill.Type = 6 Then
        save_comment_fichier_jpg...

jurassic pork · 29 Janvier 2025

jeff1494 à dit:
Je vais alors aller voir cette méthode avec attention. Et voir comment elle fonctionne.
Encore merci.

Bon j'ai essayé avec ton code cela a l'air de fonctionner , voici le code :

VB:

Sub save_comment_fichier_jpgJP(x)
    Dim pp As Object
    Set pp = CreateObject("XlDnaLibJP.PressePapier")
    Application.ScreenUpdating = False
    With Sheets("INVENDUS").Cells(x, 2)
        If Not .Comment Is Nothing Then
            .Comment.Visible = True
            retryMethod .Comment.Shape, "CopyPicture", 2, xlScreen, xlBitmap
            retryMethod pp, "SaveImage", 2, ThisWorkbook.Path & "\JPG_INV\" & Sheets("INVENDUS").Cells(x, 1) & ".jpg", 1
            .Comment.Visible = False
            pp.Clear
        End If
    End With
    Application.ScreenUpdating = True
End Sub
Function retryMethod(Obj As Object, MethodName, NbArgs, Optional Arg1, Optional Arg2, Optional Arg3)
Dim retryCount As Integer
retryCount = 0
retry:
                On Error GoTo ErrorHandler
                Select Case NbArgs
                    Case 0
                          retryMethod = CallByName(Obj, MethodName, VbMethod)
                     Case 1
                          retryMethod = CallByName(Obj, MethodName, VbMethod, Arg1)
                     Case 2
                          retryMethod = CallByName(Obj, MethodName, VbMethod, Arg1, Arg2)
                     Case 3
                          retryMethod = CallByName(Obj, MethodName, VbMethod, Arg1, Arg2, Arg3)
                End Select
                GoTo Fin
       
ErrorHandler:
                retryCount = retryCount + 1
                If retryCount <= 10 Then
                    'Sleep 20
                    Debug.Print "Retry " & MethodName & " : "; retryCount & " - Erreur: " & Err.Number
                    Resume retry
                Else
                    MsgBox "Erreur  Méthode " & MethodName & " essayée 10 fois."
                    Exit Function
                End If
Fin:
End Function

et plus besoin de sleep. Sur une série de 5000 passages voici les messages de debug que j'ai eu :

Retry SaveImage : 1 - Erreur: 440
Retry CopyPicture : 1 - Erreur: 1004
Retry CopyPicture : 1 - Erreur: 1004
Retry SaveImage : 1 - Erreur: 440
Retry CopyPicture : 1 - Erreur: 1004

ce qui veut dire qu'il n'y a eu que quelques erreurs et que c'est passé au bout d'un seul réessai

laurent950 · 29 Janvier 2025

Bonsoir @jeff1494

cela devrait etre instantané maintenant

VB:

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
    Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long
    Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long
    Private Declare PtrSafe Function CopyEnhMetaFileA Lib "gdi32" (ByVal hEmfSrc As Long, ByVal lpszFile As String) As Long
    Private Declare PtrSafe Function DeleteEnhMetaFile Lib "gdi32" (ByVal hEmf As Long) As Long
#Else
    Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function CloseClipboard Lib "user32" () As Long
    Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long
    Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long
    Private Declare Function CopyEnhMetaFileA Lib "gdi32" (ByVal hEmfSrc As Long, ByVal lpszFile As String) As Long
    Private Declare Function DeleteEnhMetaFile Lib "gdi32" (ByVal hEmf As Long) As Long
#End If

Const CF_ENHMETAFILE As Integer = 14 ' Format d'image dans le presse-papiers

Sub Export_Photos()
    Dim i As Long
    Dim FolderPath As String
    Dim objShell As Object
    Dim ImgCounter As Integer
    Dim hMetaFile As Long
    Dim SavedFilePath As String
  
    ' Crée un dossier pour les images
    MkDir ThisWorkbook.Path & "\JPG_INV"
  
    ' pour choisir le dossier où enregistrer les images
    FolderPath = ThisWorkbook.Path & "\JPG_INV"
  
    ' Vérifie si un dossier a bien été sélectionné
    If FolderPath = "" Then
        MsgBox "Aucun dossier sélectionné. Exportation annulée.", vbExclamation
        Exit Sub
    End If
  
    ' Ajoute un séparateur de chemin si nécessaire
    If Right(FolderPath, 1) <> "\" Then FolderPath = FolderPath & "\"
  
    ' Initialiser le compteur d'images
    ImgCounter = 1
  
    ' Parcours toutes les lignes de la feuille "INVENDUS"
    For i = 2 To Sheets("INVENDUS").Cells(Rows.Count, 2).End(xlUp).Row
        If Sheets("INVENDUS").Cells(i, 2).Comment.Shape.Fill.Type = 6 Then
            ' Sauvegarde le commentaire sous forme d'image
            save_comment_fichier_jpg i, FolderPath, ImgCounter
            ImgCounter = ImgCounter + 1
        End If
    Next i
  
    ' Message de confirmation
    MsgBox ImgCounter - 1 & " images ont été exportées dans " & FolderPath, vbInformation
End Sub

Sub save_comment_fichier_jpg(x As Long, FolderPath As String, ImgCounter As Integer)
    Dim hMetaFile As Long
    Dim SavedFilePath As String
    Application.ScreenUpdating = False
  
    With Sheets("INVENDUS").Cells(x, 2)
        If Not .Comment Is Nothing Then
            .Comment.Visible = True
            .Comment.Shape.CopyPicture Appearance:=xlScreen, Format:=xlPicture
          
            ' Ouvre le presse-papiers
            If OpenClipboard(0) Then
                If IsClipboardFormatAvailable(CF_ENHMETAFILE) Then
                    hMetaFile = GetClipboardData(CF_ENHMETAFILE)
                  
                    ' Sauvegarde l'image si elle est disponible
                    If hMetaFile <> 0 Then
                        'SavedFilePath = FolderPath & "Image_" & ImgCounter & ".emf" ' Origine
                        SavedFilePath = FolderPath & "Image_" & ImgCounter & ".jpg" ' Modifier volontairement en .jpg
                        If CopyEnhMetaFileA(hMetaFile, SavedFilePath) <> 0 Then
                            Debug.Print "Image enregistrée avec succès : " & SavedFilePath, vbInformation
                        Else
                            MsgBox "Erreur lors de l'enregistrement de l'image.", vbExclamation
                        End If
                        DeleteEnhMetaFile hMetaFile
                    Else
                        MsgBox "Impossible d'obtenir les données du presse-papiers.", vbExclamation
                    End If
                End If
                CloseClipboard
            Else
                MsgBox "Impossible d'ouvrir le presse-papiers.", vbExclamation
            End If
            .Comment.Visible = False
        End If
    End With
    Application.ScreenUpdating = True
End Sub

Lien vers autres solution : https://excel-downloads.com/threads/export-dimages-renommer-celles-ci.20034890/post-20677336

jeff1494 · 29 Janvier 2025

jurassic pork à dit:

Bon j'ai essayé avec ton code cela a l'air de fonctionner , voici le code :

VB:

Sub save_comment_fichier_jpgJP(x)
    Dim pp As Object
    Set pp = CreateObject("XlDnaLibJP.PressePapier")
    Application.ScreenUpdating = False
    With Sheets("INVENDUS").Cells(x, 2)
        If Not .Comment Is Nothing Then
            .Comment.Visible = True
            retryMethod .Comment.Shape, "CopyPicture", 2, xlScreen, xlBitmap
            retryMethod pp, "SaveImage", 2, ThisWorkbook.Path & "\JPG_INV\" & Sheets("INVENDUS").Cells(x, 1) & ".jpg", 1
            .Comment.Visible = False
            pp.Clear
        End If
    End With
    Application.ScreenUpdating = True
End Sub
Function retryMethod(Obj As Object, MethodName, NbArgs, Optional Arg1, Optional Arg2, Optional Arg3)
Dim retryCount As Integer
retryCount = 0
retry:
                On Error GoTo ErrorHandler
                Select Case NbArgs
                    Case 0
                          retryMethod = CallByName(Obj, MethodName, VbMethod)
                     Case 1
                          retryMethod = CallByName(Obj, MethodName, VbMethod, Arg1)
                     Case 2
                          retryMethod = CallByName(Obj, MethodName, VbMethod, Arg1, Arg2)
                     Case 3
                          retryMethod = CallByName(Obj, MethodName, VbMethod, Arg1, Arg2, Arg3)
                End Select
                GoTo Fin
      
ErrorHandler:
                retryCount = retryCount + 1
                If retryCount <= 10 Then
                    'Sleep 20
                    Debug.Print "Retry " & MethodName & " : "; retryCount & " - Erreur: " & Err.Number
                    Resume retry
                Else
                    MsgBox "Erreur  Méthode " & MethodName & " essayée 10 fois."
                    Exit Function
                End If
Fin:
End Function

et plus besoin de sleep. Sur une série de 5000 passages voici les messages de debug que j'ai eu :

ce qui veut dire qu'il n'y a eu que quelques erreurs et que c'est passé au bout d'un seul réessai

Merci encore ;
Je vais donc inclure le code que tu me donnes en lieu et place du précédent.

jurassic pork · 29 Janvier 2025

jeff1494 à dit:
Merci encore ;
Je vais donc inclure le code que tu me donnes en lieu et place du précédent.

Tu pourras tester aussi le code de laurent950 qui a l'avantage de ne pas utiliser de complément mais comme il utilise aussi le presse-papier tu risques de tomber sur les problèmes d'erreur et donc il faudra peut-être alors utiliser dedans les retryMethod.

jeff1494 · 29 Janvier 2025

laurent950 à dit:

Bonsoir @jeff1494

cela devrait etre instantané maintenant

VB:

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
    Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long
    Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long
    Private Declare PtrSafe Function CopyEnhMetaFileA Lib "gdi32" (ByVal hEmfSrc As Long, ByVal lpszFile As String) As Long
    Private Declare PtrSafe Function DeleteEnhMetaFile Lib "gdi32" (ByVal hEmf As Long) As Long
#Else
    Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function CloseClipboard Lib "user32" () As Long
    Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long
    Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long
    Private Declare Function CopyEnhMetaFileA Lib "gdi32" (ByVal hEmfSrc As Long, ByVal lpszFile As String) As Long
    Private Declare Function DeleteEnhMetaFile Lib "gdi32" (ByVal hEmf As Long) As Long
#End If

Const CF_ENHMETAFILE As Integer = 14 ' Format d'image dans le presse-papiers

Sub Export_Photos()
    Dim i As Long
    Dim FolderPath As String
    Dim objShell As Object
    Dim ImgCounter As Integer
    Dim hMetaFile As Long
    Dim SavedFilePath As String
  
    ' Crée un dossier pour les images
    MkDir ThisWorkbook.Path & "\JPG_INV"
  
    ' pour choisir le dossier où enregistrer les images
    FolderPath = ThisWorkbook.Path & "\JPG_INV"
  
    ' Vérifie si un dossier a bien été sélectionné
    If FolderPath = "" Then
        MsgBox "Aucun dossier sélectionné. Exportation annulée.", vbExclamation
        Exit Sub
    End If
  
    ' Ajoute un séparateur de chemin si nécessaire
    If Right(FolderPath, 1) <> "\" Then FolderPath = FolderPath & "\"
  
    ' Initialiser le compteur d'images
    ImgCounter = 1
  
    ' Parcours toutes les lignes de la feuille "INVENDUS"
    For i = 2 To Sheets("INVENDUS").Cells(Rows.Count, 2).End(xlUp).Row
        If Sheets("INVENDUS").Cells(i, 2).Comment.Shape.Fill.Type = 6 Then
            ' Sauvegarde le commentaire sous forme d'image
            save_comment_fichier_jpg i, FolderPath, ImgCounter
            ImgCounter = ImgCounter + 1
        End If
    Next i
  
    ' Message de confirmation
    MsgBox ImgCounter - 1 & " images ont été exportées dans " & FolderPath, vbInformation
End Sub

Sub save_comment_fichier_jpg(x As Long, FolderPath As String, ImgCounter As Integer)
    Dim hMetaFile As Long
    Dim SavedFilePath As String
    Application.ScreenUpdating = False
  
    With Sheets("INVENDUS").Cells(x, 2)
        If Not .Comment Is Nothing Then
            .Comment.Visible = True
            .Comment.Shape.CopyPicture Appearance:=xlScreen, Format:=xlPicture
          
            ' Ouvre le presse-papiers
            If OpenClipboard(0) Then
                If IsClipboardFormatAvailable(CF_ENHMETAFILE) Then
                    hMetaFile = GetClipboardData(CF_ENHMETAFILE)
                  
                    ' Sauvegarde l'image si elle est disponible
                    If hMetaFile <> 0 Then
                        'SavedFilePath = FolderPath & "Image_" & ImgCounter & ".emf" ' Origine
                        SavedFilePath = FolderPath & "Image_" & ImgCounter & ".jpg" ' Modifier volontairement en .jpg
                        If CopyEnhMetaFileA(hMetaFile, SavedFilePath) <> 0 Then
                            Debug.Print "Image enregistrée avec succès : " & SavedFilePath, vbInformation
                        Else
                            MsgBox "Erreur lors de l'enregistrement de l'image.", vbExclamation
                        End If
                        DeleteEnhMetaFile hMetaFile
                    Else
                        MsgBox "Impossible d'obtenir les données du presse-papiers.", vbExclamation
                    End If
                End If
                CloseClipboard
            Else
                MsgBox "Impossible d'ouvrir le presse-papiers.", vbExclamation
            End If
            .Comment.Visible = False
        End If
    End With
    Application.ScreenUpdating = True
End Sub

@laurent950 ;
Merci pour ton code. Je vais le garder bien au chaud. Car j'aurai d'autres occasions de m'en servir.

Un grand merci pour le temps que tu as passé sur mon problème.
Bonne soirée à toi.

patricktoulon · 29 Janvier 2025

perso si c'etait pour faire du png et exporter toute tes shapes en masse j'ai sans api sans quoi que ce soit
normalement si tu avais bien chercher dans mes ressources tu l'aurais trouvé

adaptation a ton cas

VB:

Sub Export_Photos2()
    Dim oApp As Object, sourceZip As String, destinationFolder, oFolder, oItem, i&

    sourceZip = ThisWorkbook.Path & "\zzz.zip"
    destinationFolder = ThisWorkbook.Path & "\mes images"

    Application.ScreenUpdating = False
    Set wbk = Workbooks.Add
    If Dir(ThisWorkbook.Path & "\zzz.zip") <> "" Then Kill ThisWorkbook.Path & "\zzz.zip"
    With ThisWorkbook.Sheets("INVENDUS")
        For i = 2 To .Cells(Rows.Count, 2).End(xlUp).Row
            If Not .Cells(i, 2).Comment Is Nothing Then
                If .Cells(i, 2).Comment.Shape.Fill.Type = 6 Then
                    .Cells(i, 2).Comment.Visible = True
                    .Cells(i, 2).Comment.Shape.CopyPicture Format:=xlBitmap
                    .Cells(i, 2).Comment.Visible = False

                    wbk.Sheets(1).Pictures.Paste
                End If
            End If
        Next
          End With
    wbk.SaveAs sourceZip
    Application.DisplayAlerts = False
    ActiveWorkbook.Close

    ' Définition des chemins
    If Dir(destinationFolder, vbDirectory) = "" Then MkDir destinationFolder

    ' Vérification de l'existence de l'archive ZIP
    If Dir(sourceZip) = "" Then
        MsgBox "L'archive ZIP n'existe pas.", vbExclamation, "Erreur"
        Exit Sub
    End If

    '-------------------------------------------------------
    'on dezip les fichiers image du dossier "media" du zip qui contient toute les images
    Set UnZipeur = CreateObject("Shell.Application")
    For Each Fl In UnZipeur.Namespace(sourceZip & "\xl\media").items
        'DoEvents
        UnZipeur.Namespace(destinationFolder & "\").copyhere (Fl.Path)
    Next
    Set UnZipeur = Nothing
    Kill sourceZip
End Sub

j'obtiens bien tout les png

jeff1494 · 29 Janvier 2025

@patricktoulon : En effet je n'ai pas eu le réflexe de fouiner dans tes ressources. Il va falloir que je m'habitue à le faire avant de poser une question sur le forum.

Merci à toi et bonne soirée.

patricktoulon · 29 Janvier 2025

re
non je suis pas la bible non plus mais dans mes ressource tu trouvera plusieurs solutions quand j’étais en guerre contre les api
et il y en a quelques unes
j'ai testé avec 100 cellules avec commentaires image
disons que c'est une alternative au cas ou le system de l'utilisateur est un peu juste en terme d'api et gestion d'api
voir avec le dotnet de @jurassic pork qui sur mon portable ne fonctionne pas pourtant j'ai bien le netframework 3.5 ,4.1,4.8 à jour

jeff1494 · 29 Janvier 2025

Bon si tu dis que tu n'est pas la bible je veux bien te croire, mais quand je vois tout ce que tu dépatouille comme problèmes, je me demande comment tu fais.
Bref je ne te remercierai jamais assez pour tout ce que j'ai pu apprendre grâce à tes différentes ressources.
Bonne soirée à toi.

jurassic pork · 29 Janvier 2025

patricktoulon à dit:
voir avec le dotnet de @jurassic pork qui sur mon portable ne fonctionne pas pourtant j'ai bien le netframework 3.5 ,4.1,4.8 à jour

hello patricktoulon,
qu'est-ce qui ne fonctionne pas ? Quel est l'O.S et la version d'Excel ?

patricktoulon · 29 Janvier 2025

W10 excel 2016 64 purtable Hp
j ai verifié et le netframework4.8 est à jour

jurassic pork · 29 Janvier 2025

patricktoulon à dit:
W10 excel 2016 64 purtable Hp
j ai verifié et le netframework4.8 est à jour

oui mais tu ne m'as pas dit ce qui ne fonctionnait pas ? un message d'erreur ? tu as bien fait l'install 64 bits ?

patricktoulon · 29 Janvier 2025

jeff1494 à dit:
Bon si tu dis que tu n'est pas la bible je veux bien te croire, mais quand je vois tout ce que tu dépatouille comme problèmes, je me demande comment tu fais.
Bref je ne te remercierai jamais assez pour tout ce que j'ai pu apprendre grâce à tes différentes ressources.
Bonne soirée à toi.

je réfléchi, je pense, je cherche dans les sources , j'essaie d'avoir une vue d'ensemble et non (pas à pas) dans mon développement d'applicatif
c'est l'erreur que font 90% des demandeurs (amateur ou pro) que l'on voit passer ici et même ailleurs
on développe le truc et pour le machin on verra demain arrivé a un moment on sait plus pourquoi ça marche pas
un point A vers un point B quelle est le meilleur chemin quelle sont les ambuches que je risque de me prendre in the head aije les moyen de palier aux éventuels restriction vba ou autres existent ils etc, etc....

patricktoulon · 29 Janvier 2025

jurassic pork à dit:
oui mais tu ne m'as pas dit ce qui ne fonctionnait pas ? un message d'erreur ? tu as bien fait l'install 64 bits ?

oui j ai installé le 64 mais ne t inquiet pas sur mon fixe ca marche mais je suis en excel 32 bit alors j'ai installé en 32

dit moi tu avais un lien vers un module clipboard me semble t il qui prenait tout vous avez essayer avec ?
je m'en etait inspiré pour faire ma fonction png je la i plus ce lien

jurassic pork · 29 Janvier 2025

patricktoulon à dit:
dit moi tu avais un lien vers un module clipboard me semble t il qui prenait tout vous avez essayer avec ?
je m'en etait inspiré pour faire ma fonction png je la i plus ce lien

Oui cela doit être stdClipboard . J'ai signalé d'ailleurs pour ce module une erreur dans les déclarations (voir issues)
On a pas essayé avec mais de toute façon avec toute ces méthodes on risque de tomber sur le CopyPicture qui plante (voir comment l'éviter avec ma fonction retryMethod au post #31)

XL 2021 Extraction images depuis commentaire de cellule vers dossier.

jeff1494

XLDnaute Occasionnel

Pièces jointes

laurent950

jurassic pork

XLDnaute Accro

laurent950

XLDnaute Barbatruc

jeff1494

XLDnaute Occasionnel

jurassic pork

XLDnaute Accro

jeff1494

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

jeff1494

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

jeff1494

XLDnaute Occasionnel

jurassic pork

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

jurassic pork

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

jurassic pork

XLDnaute Accro

Discussions similaires

XL 2021 Extraction images depuis commentaire de cellule vers dossier.

XLDnaute Occasionnel

Pièces jointes

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Accro

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Accro

Discussions similaires

Privacy & Transparency

Privacy & Transparency