Discussion :

[cerede2000]

Bonjour à tous,

Je cherche à exporter des images qui ont étés placées dans des commentaires sur des cellules.

J'ai déjà essayer pas mal de codes trouvé ci et la sur le net ainsi que dans les FAQ de Developpez mais rien ne fonctionne.

Premier point déjà, lorsque je parcours les Shapes de ma Worksheet elle sont de type msoComment et non de type msoPicture.
Pour vérifier qu'une image est bien présente dans la Shape commentaire je fais ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Dim sheet As Worksheet
Dim shp As Shape
 
Set sheet = ActiveSheet
 
For Each shp In sheet.Shapes
    If shp.Fill.Type = msoFillPicture Then
        Debug.Print "Il s'agit d'un commentaire avec image"
    End If
Next

Je sais donc que le commentaire est bien remplis avec un image, mais je ne trouve pas comment exporter le Fill de la Shape.

Pour info j'ai déjà essaye d'exporter la Shape complète dans une image et le fichier générer n'est pas lisible.

J'ai quelques 100 aines vois plus d'un millier d'image à exporter de ce fichier Excel
Vu qu'il s'agit d'un Xlsx j'ai déjà récupérer les images en ouvrant le fichier en tant que Zip.
Mais elle sont simplement nommé imagexxxx.jpeg mais j'ai besoin de nommer chaque image avec le nom de la cellule correspondante.

Il s'agit d'une bibliothèque d'articles.

Merci d'avance à vous

[Philippe PONS]

Salut,

je n'ai pas le temps de tester, mais la propriété UserPicture
devrait te permettre de récupérer le nom complet du fichier
et ensuite le dupliquer avec un autre nom
Cordialement,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Comment.Shape.Fill.UserPicture

[cerede2000]

J'ai déjà regardé du côté de cette méthode mais d'après MSDN elle ne sert qu'as remplir l'image mais pas à la récupérer
https://msdn.microsoft.com/en-us/lib...ffice.11).aspx

[patricktoulon]

Bonjour

heu oui !!....
sinon y a plus simple

il y a la méthode export du chart dans la faq et même plusieurs fois sur ce forum tu trouvera des exemple
le theme le plus souvent abordé est "sauvegarder une image d'un sheets dans un fichier
parti de la on applique la même méthode avec le commentaire

wagadougou!!!!!!!

cet exemple copie le commentaire de la cellule (3,2)en image et l'exporte avec un graph temporaire au même endroit ou se trouve le classeur
il te sera facile après de créer ta boucle sur toutes les cellules concernées

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub test1()
Application.ScreenUpdating = False
     With Cells(3, 2)
         If Not .Comment Is Nothing Then
             .Comment.Visible = True
             .Comment.Shape.CopyPicture
              With Sheets(1).ChartObjects.Add(0, 0, .Comment.Shape.Width, .Comment.Shape.Height).Chart
                 .Paste
                 .Export ThisWorkbook.Path & "\" & cells(3,2).value & ".JPG", "JPG"
              End With
              sheets(1).ChartObjects(.Parent.ChartObjects.Count).Delete
 
             .Comment.Visible = False
         End If
     End With
     Application.ScreenUpdating = True
End Sub

wagadougou!!!!!

[cerede2000]

J'avais essayé cette technique mais l'image n'étais pas lisible.

Je n'affichais pas le commentaire, il se peu que ce soit à cause de ça

J'ai fais mas boucle mais j'ai un autre souci, la 1ere image est ok, mais toutes les autres sont blanches !

Alors que si j’exécute le code en debug pas à pas les images sont ok....

[patricktoulon]

donne moi un exemplaire en xlsx avec les cellules avec leur commentaires en enlevant tout ce qui peut etre confidentiel
je vais regarder cela de plus prêt

[cerede2000]

@patricktoulon : envoyé en MP

[patricktoulon]

a ben oui voila !!!!!
tu a ouvert ton fichier avec winrar au paravent et bien maintenant ton fichier est corrompu

chez moi pour l'ouvrir excel a du supprimer tout les commentaires c'est baloh!!!! surtout que je t'avais demandé en xlsx(sans macro) pas en xlm hein!!!!

je viens de faire un test chez moi avec un nouveau classeur et quelques cellules avec commentaires images et ca fonctionne très bien dans une boucle

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub test3()
For i = 4 To 7
save_comment_fichier_jpg i
Next
End Sub
Sub save_comment_fichier_jpg(x)
Application.ScreenUpdating = False
     With Cells(x, 2)
         If Not .Comment Is Nothing Then
             .Comment.Visible = True
             .Comment.Shape.CopyPicture
              With Sheets(1).ChartObjects.Add(0, 0, .Comment.Shape.Width, .Comment.Shape.Height).Chart
                 .Paste
                 .Export ThisWorkbook.Path & "\" & Cells(x, 2) & ".jpg", "JPG"
              End With
              .Parent.ChartObjects(.Parent.ChartObjects.Count).Delete
 
             .Comment.Visible = False
         End If
     End With
     Application.ScreenUpdating = True
End Sub

demo en image

[patricktoulon]

oserai je ajouter qu'un fichier excel de plus de 31 mega va certainement t'apporter que des soucis

j'dis ca moi hein!......

[cerede2000]

oserai je ajouter qu'un fichier excel de plus de 31 mega va certainement t'apporter que des soucis

j'dis ca moi hein!......

C'est mon fournisseur qui la ainsi...

Je veux juste en extraire les images et après poubelle

J'ai toujours le fichier original, je vais le reprendre et lancer la macro dessus.

PS : Par curiosité, comment sais tu qu'il à été ouvert avec Winrar

[patricktoulon]

heu comment
et bien d'une part tu l'a dis au départ quand tu a dis que tu avais déjà extrait les image mais que les noms c'est img 0 etc....
il n'y a qu'une seule façon d'arriver a ce résultat c'est winrar et il y a un autre moyen de savoir mais c'est compliqué en regardant un certains fichier dans le .rar obtenu


envoie moi la feuille en XLSX JE VAIS VERIFIER


après tu que tu le fait une fois puis poubelle
est ce que cela devra se renouveler périodiquement ???

[cerede2000]

lol XLSX pas de soucis, par contre la feuille d'origine est protéger (je l'ai déprotéger en editant le XML et en virant la balise sheetprotection).
Le fichier que je t'envoi (en MP toujours) est celui d'origine sans modifs de ma part.

Non je n'ai besoin de le faire qu'une fois, ou alors dans 1 an quand il y aura de nouveaux articles mais d'ici la.....

En fait pour extraire les images et modifier le XML, je renomme simplement en ZIP et j'ouvre avec l'explorateur Windows, pas besoin d'arme lourde comme Winrar

Upload en cours mais à 1M ça prends quelques minutes lol

PS : Sans vouloir abuser Si tu arrive à virer complètement le tour et l'ombre qui est généré par la shape et le graph je suis prenneur

[patricktoulon]

afin que je puisse t'aider pourrais tu envoyer pour la dernière fois un fichier utilisable xlsx et sans protection afin que je galère pas a ouvrir le fichier ou même en zip

sinon je laisse tomber

[cerede2000]

Ok renvoyé en MP, fichier propre XLSX

[patricktoulon]

Bon comme il y avais toujours la protection dans le dernier envoie j'ai pris un autre chemin
voila

maintenant tu prend ton xlx ou xlm
tu lui met un module
et tu colle ca dans le module
et lance la sub "c_est_parti"
c'est un peu long mais ca fonctionne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Sub c_est_parti()
    On Error Resume Next
    MkDir ThisWorkbook.Path & "\imgrecup"
    Err.Clear
    Sheets.Add After:=Sheets(Sheets.Count)
    With Sheets(2).ChartObjects.Add(0, 0, 100, 100).Chart
        .Parent.Name = "calque"
    End With
    For i = 6 To Sheets(1).Cells(Rows.Count, 2).End(xlUp).Row
        If Sheets(1).Cells(i, 2).Comment.Shape.Fill.Type = 6 Then
        save_comment_fichier_jpg i
    End If
    Next
Sheets(2).ChartObjects(Sheets(2).ChartObjects.Count).Delete
End Sub
Sub save_comment_fichier_jpg(x)
    Application.ScreenUpdating = False
    With Sheets(1).Cells(x, 2)
        If Not .Comment Is Nothing Then
            .Comment.Visible = True
            .Comment.Shape.CopyPicture
            With Sheets(2).ChartObjects("calque")
            .Height = Sheets(1).Cells(x, 2).Comment.Shape.Height
            .Width = Sheets(1).Cells(x, 2).Comment.Shape.Width
                .Chart.Paste
                .Chart.Export ThisWorkbook.Path & "\imgrecup\" & Sheets(1).Cells(x, 2) & ".jpg", "JPG"
            End With
 
            .Comment.Visible = False
        End If
    End With
    Application.ScreenUpdating = True
End Sub

demo debut des 1eres copie en image

[cerede2000]

Super merci !!!

Pour le dernier XLSX je ne comprends pas, il n'est pas protéger

Peux tu faire un dernier test sur les lignes 1596 et 1597, je ne comprends pas pourquoi les images sont tronquées en bas, il manque un bout.

Quel outils utilise tu pour faire des live screen capture en GIF ?

[patricktoulon]

bonjour por tes deux imaghes tronquées je vaos regarder
pour les captureS c'est LICECAP C EST UN FREEWARE°

[cerede2000]

Ok merci

Merci également pour LiceCAP, j'ai trouvé également un outil similaire qui s'appel ScreenToGif, freeware également qui rajoute une couche d'édition après capture.
Tu peux ajouter des shapes, de la transparence cinématographique...

[patricktoulon]

Bonjour
oui je connaissais mais il est lourd et pour faire simplement des captures pour démo c'est mieux lice cap

[Serge.denni]

Bonjour,

J'ai un petit surement tout petit problème ou vous aurez surement la réponse je cherche mais je ne trouve pas.
j' ai copié collé le code et chez moi l'extraction ce fait bien mais les images sont blanches, quelqu un peu me dire pouquoi ?
je suis sous office 365

d'avance merci