Enregistrement auto sur disque d'images dans cellules

Le 11/06/2018 à 12:36

Bonjour chers tous,

Je cherche à faire quelque chose qui me semble simple mais je m'arrache les cheveux !!! Voici le problème :

Je reçois d'un tiers (donc je n'ai pas la main dessus) un fichiers Excel comprenant une colonne dans les cellules de laquelle j'ai un lien html et un image.

Je souhaiterais pouvoir (par exemple par macro), enregistrer chaque image contenue dans une cellule dans un fichier image correspondant sur le disque local (disque dur).

Si quelqu'un a une piste, un doc, une idée et pourquoi pas une solution ?

MERCI d'avance à ceux qui se pencheront sur le problème

Falck.

Le 11/06/2018 à 12:54

Bonjour Falck et bienvenue sur le Forum ^^

Pour ton problème, je pense que tu devrais utiliser l'enregistreur de macro pour ouvrir ton lien HTML et l'enregistrer dans le dossier souhaité.

Une fois que tu a ce bout de macro avec toi, tu créé une boucle pour répéter l'action selon ton nombre de ligne.

Voici ce que sa devrait donner

prend le temps de lire les commentaires en vert pour adapter à ton fichier si besoin ;D

Sub Enregistrement_auto()
Dim NbrLigne As Integer 'Déclaration variable NbrLigne pour boucle
NbrLigne = .Cells(.Rows.Count, "A").End(xlUp).Row - 1 'compte le nbr de ligne de la colonne A
While NbrLig <> 0 'déclaration boucle, tant que NbrLig est différent de 0
    Range("B2").Select 'on va dire que ta colonne de lien HTML commence en B2 et pars vers le bas
    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True 'ouvre le lien hypertexte
    ActiveWorkbook.SaveAs Filename:="P:\exemple", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close 'ferme le lien hypertexte
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp 'supprime la ligne qui viens d'être enregistré
    NbrLigne = NbrLigne - 1 'on enlève un de notre variable et on recommence la boucle
Wend
End Sub

Voilà! Si sa ne conviens pas, je reste à ta dispo

Le 11/06/2018 à 15:05

Bonjour Juice et Merci pour cette rapidité de réponse et cet accueil chaleureux !!

Après lecture et test de ton code, je pense qu'il ne répond pas tout a fait à mon problème (ou je ne comprend pas comment l'adapter).

En fait, le lien HTML ne m'intéresse pas tant que ca c'est surtout l'image qui ai déjà dans la cellule que je voudrais enregistrer :

un exemple vaut mieux qu'un grand discours (voir ci-joint).

C'est chaque image que je voudrais enregistrer séparément, malheureusement l'enregistreur de macro ne me donne aucun code quand je fait la manip et je ne voie pas d'objet VBA permettant d'accéder à l'image...

En espérant être un petit peu plus claire...

exemple
Le 11/06/2018 à 15:36

Falck,

Voici une macro trouver sur le net que j'ai adapter à ce que tu veux 

Option Explicit

Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hwnd As Long, ByVal lpOperation As String, _
    ByVal lpFile As String, ByVal lpParameters As String, _
    ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Sub Image_ClipBoard()
Dim x As Byte
Dim Sh As Shape
Dim monImage As String

'Compte le nombre d'objet initial dans la feuille
x = ActiveSheet.Shapes.Count

Application.ScreenUpdating = False
ActiveSheet.Range("A1").Select
'Colle le contenu du presse papier dans la feuille de calcul
ActiveSheet.Paste

'vérifie si le collage effectué correspond à une image
If x = ActiveSheet.Shapes.Count Then
    Application.ScreenUpdating = True
    MsgBox "Opération annulée"
    Exit Sub

    Else
 While x <> 0
    'Récupère la dernière forme de la feuille
    Set Sh = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
    'Définit le nom et le lieu de stockage de l'image
    monImage = "C:\chemin\nomficher" & x & ".jpg"

    'Colle l'image dans un graphique
    With ActiveSheet.ChartObjects.Add(0, 0, Sh.Width, Sh.Height).Chart
        .Paste
        'Sauvegarde l'image du graphique au format jpg
        .Export monImage, "JPG"
    End With

    'Supprime le graphique et la forme.
    With ActiveSheet
        .ChartObjects(ActiveSheet.ChartObjects.Count).Delete
        .Shapes(ActiveSheet.Shapes.Count).Delete
    End With

    Application.ScreenUpdating = True
    x = x - 1
Wend
End If
End Sub

Deux choses à savoir sur cette macro :

1° Il faut que tu copie toutes les images présentes dans ta feuille avant de lancer ta macro (Ctrl + clic droit + copier) car la macro va enregistrer les images dans le presse papier et donc que tu a copier

2° Le nom du fichier serra celui que tu aura renseigné dans ta macro + le n° de la variable au moment de l'enregistrement de l'image. L'avantage c'est que tout serra enregistrer, mais le désavantage c'est que tu devra les déplacer dans un autre dossier après l'utilisation de ta macro

Bref, j'te laisse essayé et tu me dit si tu a besoin de modif ;D

Le 11/06/2018 à 17:09

Cher Juce,

Encore une fois MERCI ! que du bonheur !

Cela correspond parfaitement à ce que je cherche. Reste un tout petit point que je n'arrive pas a modifier.

Les fichiers s'enregistrent bien dans le repertoire Chemin mais il ont la forme telle que dans le fichier ci-joint…

au lieu de l'image d'origine.

A ce sujet, je vois que tu fais un paste:

With ActiveSheet.ChartObjects.Add(0, 0, Sh.Width, Sh.Height).Chart
        .Paste
        'Sauvegarde l'image du graphique au format jpg
        .Export monImage, "JPG"
    End With

Mais je n'ais pas vue de copy. J'ai donc essayé un Sh.copy mais sans succès.

Si un dernier petit coups de main est possible...?

Quoiqu'il en soit un grand merci pour cette avancé !

nomficher9
Le 11/06/2018 à 17:50

Mon cher Falck,

Ravie que cette macro te plaise

En faite c'est que dans la macro, j'ai donner l'ordre d'enregistrer sous le format JPG.

Il te suffit de changer l'extension du format ici :

 While x <> 0
    'Récupère la dernière forme de la feuille
    Set Sh = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
    'Définit le nom et le lieu de stockage de l'image
    monImage = "C:\chemin\nomficher" & x & ".jpg" 'ICI REMPLACE LE JPG PAR LE FORMAT QUE TU SOUHAITE

et/ou ici :

   With ActiveSheet.ChartObjects.Add(0, 0, Sh.Width, Sh.Height).Chart
        .Paste
        'Sauvegarde l'image du graphique au format jpg
        .Export monImage, "JPG" 'ICI REMPLACE LE JPG PAR LE FORMAT QUE TU SOUHAITE

Si sa ne résout pas ton problème, donne moi plus d'info sur

  • Le format initiale de ton image que tu souhaite enregistrer par cette macro
  • Quelle "forme" souhaite tu que l'image ai après enregistrement
  • C'était bien un graphique que tu voulais enregistrer ou sa a complètement foirer xD ?
Le 11/06/2018 à 18:26

Merci Juice,

Mais je ne suis pas certain d'avoir compris.

En effet, le format d'enregistrement de l'image me conviens tout à fait mais le problème c'est que le contenu de l'image ne correspond en rien à l'image de départ dans ma cellule (et qui n'est pas un graphique).

Par rapport aux exemples au départ j'ai un schémas de camion et à l'arrivé j'ai un graphique en histogram...

et le changement d'extension n'y a malheureusement pas changé grand choses...

Du coups

- Le format initiale de ton image que tu souhaite enregistrer par cette macro

==> Je ne sais pas (le fichier viens d'un tier) et je n'ai pas trouver des infos dans ma feuille excel...

- Quelle "forme" souhaite tu que l'image ai après enregistrement

==> le format n'a pas d'importance pour ce que je veux en faire (JPEG, BMP, PNG, TIFF…)

- C'était bien un graphique que tu voulais enregistrer ou sa a complètement foirer xD

==> Non ce n'est pas un graphique au sens "mathématique" du terme mais une figures/image.

Merci de ta patience et de ton aide !!

Le 11/06/2018 à 18:49

Falck,

Merci de ton retour

Est-ce que tu peux mettre ton Excel avec l'image originale et vierge de toute donnée confidentielle / personnelle en fichier joint ?

Je regarde et je reviens vers toi demain (j'ai une série qui m'attend <3)

Le 12/06/2018 à 10:14

Juice,

Merci du soutient et j'espère que la série a été bonne!

Je joints un fichier exemple quasiment tel que je le reçois.

J'ai intégré ta proposition de macro et j'ai simplement modifié le type de la variable x de Bytes à integer (mon VBA couinait…).

Encore merci du temps passé !

23exemple.xlsm (55.59 Ko)
Le 12/06/2018 à 12:03

Falck,

Je viens d'effectuer une batterie de test avec ton fichier et le mien en parallèle et voilà ce que j'en conclue :

La macro que je t'ai apporter permet en faite d'exporter qu'une seule image à la fois. Si il y en a plusieurs, elle ferra l'exportation de l'une des images copiées autant de fois qu'il y a d'image sur la feuille active.

La première solution que je te propose (et essaye actuellement de mettre en place) c'est de créer une boucle qui :

  • 1 ) Copie l'une des images sur une autre Feuille
  • 2 ) Lance la macro de l'enregistrement de l'image sur cette Feuille où il n'y a donc qu'une image
  • 3 ) L'image enregistrer serra ensuite supprimer de la Feuille
  • 4 ) Recommence l'opération avec une autre image

La seconde solution serrai de te créer un fichier vierge te servant uniquement à l'enregistrement de l'image que tu aura manuellement copier / coller dans ce fichier et fonctionnerai ainsi :

  • 1 ) Sur ton fichier original reçu par un de tes tiers, tu copie l'image que tu souhaite enregistrer
  • 2 ) Tu la colle sur le fichier traitement
  • 3 ) Tu lance la macro enregistrement
  • 4 ) Tu recommence avec une autre image

La seconde solution serrai plus aisé à mettre en place que la première mais nécessite que tu réalise le copier / coller de l'image manuellement (autant de fois que tu a d'image).

Mais d'un autre côté, la première solution t'obligerai à copier la macro sur tout les fichiers tiers que tu reçois où tu souhaite enregistrer les images reçus.

Je pense donc que te faire un fichier traitement (2nd solution) serais plus avantageux pour toi comme pour moi, mais dit moi ce que tu préfèrerais que je te mette en place.

Enfin, je ne comprend pas pourquoi tes images s'enregistre sous forme de graphique car moi je n'ai pas le problème quand je lance la macro avec tes images et ton fichier D:

Un autre problème que nous solutionnerons plus tard

Le 12/06/2018 à 16:26

Cher Juice,

Un énorme merci de ton temps et de ton implication.

Comme le soulignait le commentaire que tu as déposé, le problème est d'accéder aux différentes figures.

Tes différents commentaires mon permis d'écrie le code ci-dessous qui répond à ma problématique :

Sub Enregistrement()

Dim MesImages As Shape ' Container pour mes images
Dim monImage As String   ' pour mon nom de fichier
Dim i As Integer             'pour incrémenter mon nom de fichier    

  i = 0
  monImage = "C:\chemin\nomficher" & i & ".JPG"  ' C est juste par habitude d initalisaiton

 For Each MesImages In ActiveSheet.Shapes ' MesImages contient l'integralité des images et graphique

    If Not Intersect(MesImages.TopLeftCell, Range("A:A")) Is Nothing Then  'Ici seul ceux de la colonne A m'interesse
    MesImages.Copy   ' Je les copies pour pouvoir les coller dans un Chart comme expliqué par Juice
    i = MesImages.TopLeftCell.Row
    monImage = "C:\chemin\nomficher" & i & ".JPG"
    'Colle l'image dans un graphique
    With ActiveSheet.ChartObjects.Add(0, 0, MesImages.Width, MesImages.Height).Chart
        .Paste
        'Sauvegarde l'image du graphique au format jpg
        .Export monImage, "JPG"
    End With

End If
Next MesImages

End Sub

Encore une fois avec tout mes remerciments pour cette recherche conjointe d'une solution

A ta dispo si jamais...

Rechercher des sujets similaires à "enregistrement auto disque images"